Mercurial > emacs
annotate lisp/gnus/rfc2047.el @ 89573:6b5d42f51038
(x_get_font_repertory): Handle the case that the
encoding of font is other than Unicode.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Mon, 06 Oct 2003 11:23:25 +0000 |
parents | 375f2633d815 |
children | 561b856c5b1f |
rev | line source |
---|---|
38413
a26d9b55abb6
Some fixes to follow coding conventions in files from Gnus.
Pavel Janík <Pavel@Janik.cz>
parents:
35985
diff
changeset
|
1 ;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages |
50881
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
2 ;; Copyright (C) 1998, 1999, 2000, 2002, 2003 Free Software Foundation, Inc. |
31717 | 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 | |
34674 | 25 ;; RFC 2047 is "MIME (Multipurpose Internet Mail Extensions) Part |
26 ;; Three: Message Header Extensions for Non-ASCII Text". | |
27 | |
31717 | 28 ;;; Code: |
29 | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
30 (eval-when-compile |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
31 (require 'cl) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
32 (defvar message-posting-charset)) |
31717 | 33 |
34 (require 'qp) | |
35 (require 'mm-util) | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
36 ;; Fixme: Avoid this (used for mail-parse-charset) mm dependence on gnus. |
31717 | 37 (require 'mail-prsvr) |
33304 | 38 (require 'base64) |
39 (autoload 'mm-body-7-or-8 "mm-bodies") | |
33127
eca95f9d7f05
(base64): Require unconditionally.
Dave Love <fx@gnu.org>
parents:
31764
diff
changeset
|
40 |
31717 | 41 (defvar rfc2047-header-encoding-alist |
50881
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
42 '(("Newsgroups\\|Followup-To" . nil) |
31717 | 43 ("Message-ID" . nil) |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
44 ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\)" . |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
45 address-mime) |
31717 | 46 (t . mime)) |
47 "*Header/encoding method alist. | |
48 The list is traversed sequentially. The keys can either be | |
33304 | 49 header regexps or t. |
31717 | 50 |
51 The values can be: | |
52 | |
53 1) nil, in which case no encoding is done; | |
54 2) `mime', in which case the header will be encoded according to RFC2047; | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
55 3) `address-mime', like `mime', but takes account of the rules for address |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
56 fields (where quoted strings and comments must be treated separately); |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
57 4) a charset, in which case it will be encoded as that charset; |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
58 5) `default', in which case the field will be encoded as the rest |
31717 | 59 of the article.") |
60 | |
61 (defvar rfc2047-charset-encoding-alist | |
62 '((us-ascii . nil) | |
63 (iso-8859-1 . Q) | |
64 (iso-8859-2 . Q) | |
65 (iso-8859-3 . Q) | |
66 (iso-8859-4 . Q) | |
67 (iso-8859-5 . B) | |
68 (koi8-r . B) | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
69 (iso-8859-7 . B) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
70 (iso-8859-8 . B) |
31717 | 71 (iso-8859-9 . Q) |
33304 | 72 (iso-8859-14 . Q) |
73 (iso-8859-15 . Q) | |
31717 | 74 (iso-2022-jp . B) |
75 (iso-2022-kr . B) | |
76 (gb2312 . B) | |
35838
53eebdb81828
2001-02-01 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
35453
diff
changeset
|
77 (big5 . B) |
53eebdb81828
2001-02-01 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
35453
diff
changeset
|
78 (cn-big5 . B) |
31717 | 79 (cn-gb . B) |
80 (cn-gb-2312 . B) | |
81 (euc-kr . B) | |
82 (iso-2022-jp-2 . B) | |
83 (iso-2022-int-1 . B)) | |
84 "Alist of MIME charsets to RFC2047 encodings. | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
85 Valid encodings are nil, `Q' and `B'. These indicate binary (no) encoding, |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
86 quoted-printable and base64 respectively.") |
31717 | 87 |
88 (defvar rfc2047-encoding-function-alist | |
89 '((Q . rfc2047-q-encode-region) | |
90 (B . rfc2047-b-encode-region) | |
91 (nil . ignore)) | |
92 "Alist of RFC2047 encodings to encoding functions.") | |
93 | |
94 (defvar rfc2047-q-encoding-alist | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
95 '(("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\):" |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
96 . "-A-Za-z0-9!*+/" ) |
31764 | 97 ;; = (\075), _ (\137), ? (\077) are used in the encoded word. |
35985
b9c371244b90
(rfc2047-fold-region): Don't forward-char at EOB.
Dave Love <fx@gnu.org>
parents:
35838
diff
changeset
|
98 ;; Avoid using 8bit characters. |
31764 | 99 ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?" |
100 ("." . "\010\012\014\040-\074\076\100-\136\140-\177")) | |
31717 | 101 "Alist of header regexps and valid Q characters.") |
102 | |
103 ;;; | |
104 ;;; Functions for encoding RFC2047 messages | |
105 ;;; | |
106 | |
107 (defun rfc2047-narrow-to-field () | |
108 "Narrow the buffer to the header on the current line." | |
109 (beginning-of-line) | |
110 (narrow-to-region | |
111 (point) | |
112 (progn | |
113 (forward-line 1) | |
114 (if (re-search-forward "^[^ \n\t]" nil t) | |
115 (progn | |
116 (beginning-of-line) | |
117 (point)) | |
118 (point-max)))) | |
119 (goto-char (point-min))) | |
120 | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
121 (defvar rfc2047-encoding-type 'address-mime |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
122 "The type of encoding done by `rfc2047-encode-region'. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
123 This should be dynamically bound around calls to |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
124 `rfc2047-encode-region' to either `mime' or `address-mime'. See |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
125 `rfc2047-header-encoding-alist', for definitions.") |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
126 |
31717 | 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." | |
130 (interactive "*") | |
131 (save-excursion | |
132 (goto-char (point-min)) | |
133 (let (alist elem method) | |
134 (while (not (eobp)) | |
135 (save-restriction | |
136 (rfc2047-narrow-to-field) | |
137 (if (not (rfc2047-encodable-p)) | |
50881
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
138 (prog1 |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
139 (if (and (eq (mm-body-7-or-8) '8bit) |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
140 (mm-multibyte-p) |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
141 (mm-coding-system-p |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
142 (car message-posting-charset))) |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
143 ;; 8 bit must be decoded. |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
144 (mm-encode-coding-region |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
145 (point-min) (point-max) |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
146 (mm-charset-to-coding-system |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
147 (car message-posting-charset)))) |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
148 ;; No encoding necessary, but folding is nice |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
149 (rfc2047-fold-region |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
150 (save-excursion |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
151 (goto-char (point-min)) |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
152 (skip-chars-forward "^:") |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
153 (when (looking-at ": ") |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
154 (forward-char 2)) |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
155 (point)) |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
156 (point-max))) |
31717 | 157 ;; We found something that may perhaps be encoded. |
158 (setq method nil | |
159 alist rfc2047-header-encoding-alist) | |
160 (while (setq elem (pop alist)) | |
161 (when (or (and (stringp (car elem)) | |
162 (looking-at (car elem))) | |
163 (eq (car elem) t)) | |
164 (setq alist nil | |
165 method (cdr elem)))) | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
166 (goto-char (point-min)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
167 (re-search-forward "^[^:]+: *" nil t) |
31717 | 168 (cond |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
169 ((eq method 'address-mime) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
170 (rfc2047-encode-region (point) (point-max))) |
31717 | 171 ((eq method 'mime) |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
172 (let (rfc2047-encoding-type) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
173 (rfc2047-encode-region (point) (point-max)))) |
31717 | 174 ((eq method 'default) |
175 (if (and (featurep 'mule) | |
33815
61c7f3065929
(rfc2047-encode-message-header): Don't encode if
Dave Love <fx@gnu.org>
parents:
33304
diff
changeset
|
176 (if (boundp 'default-enable-multibyte-characters) |
61c7f3065929
(rfc2047-encode-message-header): Don't encode if
Dave Love <fx@gnu.org>
parents:
33304
diff
changeset
|
177 default-enable-multibyte-characters) |
31717 | 178 mail-parse-charset) |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
179 (mm-encode-coding-region (point) (point-max) |
31717 | 180 mail-parse-charset))) |
181 ((mm-coding-system-p method) | |
33815
61c7f3065929
(rfc2047-encode-message-header): Don't encode if
Dave Love <fx@gnu.org>
parents:
33304
diff
changeset
|
182 (if (and (featurep 'mule) |
61c7f3065929
(rfc2047-encode-message-header): Don't encode if
Dave Love <fx@gnu.org>
parents:
33304
diff
changeset
|
183 (if (boundp 'default-enable-multibyte-characters) |
61c7f3065929
(rfc2047-encode-message-header): Don't encode if
Dave Love <fx@gnu.org>
parents:
33304
diff
changeset
|
184 default-enable-multibyte-characters)) |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
185 (mm-encode-coding-region (point) (point-max) method))) |
31717 | 186 ;; Hm. |
187 (t))) | |
188 (goto-char (point-max))))))) | |
189 | |
35985
b9c371244b90
(rfc2047-fold-region): Don't forward-char at EOB.
Dave Love <fx@gnu.org>
parents:
35838
diff
changeset
|
190 ;; Fixme: This, and the require below may not be the Right Thing, but |
b9c371244b90
(rfc2047-fold-region): Don't forward-char at EOB.
Dave Love <fx@gnu.org>
parents:
35838
diff
changeset
|
191 ;; should be safe just before release. -- fx 2001-02-08 |
b9c371244b90
(rfc2047-fold-region): Don't forward-char at EOB.
Dave Love <fx@gnu.org>
parents:
35838
diff
changeset
|
192 (eval-when-compile (defvar message-posting-charset)) |
b9c371244b90
(rfc2047-fold-region): Don't forward-char at EOB.
Dave Love <fx@gnu.org>
parents:
35838
diff
changeset
|
193 |
33304 | 194 (defun rfc2047-encodable-p () |
195 "Return non-nil if any characters in current buffer need encoding in headers. | |
196 The buffer may be narrowed." | |
35985
b9c371244b90
(rfc2047-fold-region): Don't forward-char at EOB.
Dave Love <fx@gnu.org>
parents:
35838
diff
changeset
|
197 (require 'message) ; for message-posting-charset |
31717 | 198 (let ((charsets |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
199 (mm-find-mime-charset-region (point-min) (point-max)))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
200 (and charsets (not (equal charsets (list message-posting-charset)))))) |
31717 | 201 |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
202 ;; Use this syntax table when parsing into regions that may need |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
203 ;; encoding. Double quotes are string delimiters, backslash is |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
204 ;; character quoting, and all other RFC 2822 special characters are |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
205 ;; treated as punctuation so we can use forward-sexp/forward-word to |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
206 ;; skip to the end of regions appropriately. Nb. ietf-drums does |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
207 ;; things differently. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
208 (defconst rfc2047-syntax-table |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
209 (let ((table (make-char-table 'syntax-table '(2)))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
210 (modify-syntax-entry ?\\ "\\" table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
211 (modify-syntax-entry ?\" "\"" table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
212 (modify-syntax-entry ?\( "." table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
213 (modify-syntax-entry ?\) "." table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
214 (modify-syntax-entry ?\< "." table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
215 (modify-syntax-entry ?\> "." table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
216 (modify-syntax-entry ?\[ "." table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
217 (modify-syntax-entry ?\] "." table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
218 (modify-syntax-entry ?: "." table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
219 (modify-syntax-entry ?\; "." table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
220 (modify-syntax-entry ?, "." table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
221 (modify-syntax-entry ?@ "." table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
222 table)) |
31717 | 223 |
224 (defun rfc2047-encode-region (b e) | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
225 "Encode words in region B to E that need encoding. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
226 By default, the region is treated as containing RFC2822 addresses. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
227 Dynamically bind `rfc2047-encoding-type' to change that." |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
228 (save-restriction |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
229 (narrow-to-region b e) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
230 (if (eq 'mime rfc2047-encoding-type) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
231 ;; Simple case -- treat as single word. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
232 (progn |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
233 (goto-char (point-min)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
234 ;; Does it need encoding? |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
235 (skip-chars-forward "\000-\177" e) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
236 (unless (eobp) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
237 (rfc2047-encode b e))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
238 ;; `address-mime' case -- take care of quoted words, comments. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
239 (with-syntax-table rfc2047-syntax-table |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
240 (let ((start (point)) ; start of current token |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
241 end ; end of current token |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
242 ;; Whether there's an encoded word before the current |
50881
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
243 ;; token, either immediately or separated by space. |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
244 last-encoded) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
245 (goto-char (point-min)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
246 (condition-case nil ; in case of unbalanced quotes |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
247 ;; Look for rfc2822-style: sequences of atoms, quoted |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
248 ;; strings, specials, whitespace. (Specials mustn't be |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
249 ;; encoded.) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
250 (while (not (eobp)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
251 (setq start (point)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
252 ;; Skip whitespace. |
50881
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
253 (unless (= 0 (skip-chars-forward " \t\n")) |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
254 (setq start (point))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
255 (cond |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
256 ((not (char-after))) ; eob |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
257 ;; else token start |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
258 ((eq ?\" (char-syntax (char-after))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
259 ;; Quoted word. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
260 (forward-sexp) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
261 (setq end (point)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
262 ;; Does it need encoding? |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
263 (goto-char start) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
264 (skip-chars-forward "\000-\177" end) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
265 (if (= end (point)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
266 (setq last-encoded nil) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
267 ;; It needs encoding. Strip the quotes first, |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
268 ;; since encoded words can't occur in quotes. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
269 (goto-char end) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
270 (delete-backward-char 1) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
271 (goto-char start) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
272 (delete-char 1) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
273 (when last-encoded |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
274 ;; There was a preceding quoted word. We need |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
275 ;; to include any separating whitespace in this |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
276 ;; word to avoid it getting lost. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
277 (skip-chars-backward " \t") |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
278 ;; A space is needed between the encoded words. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
279 (insert ? ) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
280 (setq start (point) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
281 end (1+ end))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
282 ;; Adjust the end position for the deleted quotes. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
283 (rfc2047-encode start (- end 2)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
284 (setq last-encoded t))) ; record that it was encoded |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
285 ((eq ?. (char-syntax (char-after))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
286 ;; Skip other delimiters, but record that they've |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
287 ;; potentially separated quoted words. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
288 (forward-char) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
289 (setq last-encoded nil)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
290 (t ; normal token/whitespace sequence |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
291 ;; Find the end. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
292 (forward-word 1) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
293 (skip-chars-backward " \t") |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
294 (setq end (point)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
295 ;; Deal with encoding and leading space as for |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
296 ;; quoted words. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
297 (goto-char start) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
298 (skip-chars-forward "\000-\177" end) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
299 (if (= end (point)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
300 (setq last-encoded nil) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
301 (when last-encoded |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
302 (goto-char start) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
303 (skip-chars-backward " \t") |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
304 (insert ? ) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
305 (setq start (point) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
306 end (1+ end))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
307 (rfc2047-encode start end) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
308 (setq last-encoded t))))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
309 (error (error "Invalid data for rfc2047 encoding: %s" |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
310 (buffer-substring b e))))))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
311 (rfc2047-fold-region b (point)))) |
31717 | 312 |
313 (defun rfc2047-encode-string (string) | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
314 "Encode words in STRING. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
315 By default, the string is treated as containing addresses (see |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
316 `rfc2047-special-chars')." |
31717 | 317 (with-temp-buffer |
318 (insert string) | |
319 (rfc2047-encode-region (point-min) (point-max)) | |
320 (buffer-string))) | |
321 | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
322 (defun rfc2047-encode (b e) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
323 "Encode the word(s) in the region B to E. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
324 By default, the region is treated as containing addresses (see |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
325 `rfc2047-special-chars')." |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
326 (let* ((mime-charset (mm-find-mime-charset-region b e)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
327 (cs (if (> (length mime-charset) 1) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
328 ;; Fixme: Instead of this, try to break region into |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
329 ;; parts that can be encoded separately. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
330 (error "Can't rfc2047-encode `%s'" |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
331 (buffer-substring b e)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
332 (setq mime-charset (car mime-charset)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
333 (mm-charset-to-coding-system mime-charset))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
334 ;; Fixme: Better, calculate the number of non-ASCII |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
335 ;; characters, at least for 8-bit charsets. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
336 (encoding (if (assq mime-charset |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
337 rfc2047-charset-encoding-alist) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
338 (cdr (assq mime-charset |
31717 | 339 rfc2047-charset-encoding-alist)) |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
340 'B)) |
31717 | 341 (start (concat |
342 "=?" (downcase (symbol-name mime-charset)) "?" | |
343 (downcase (symbol-name encoding)) "?")) | |
344 (first t)) | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
345 (if mime-charset |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
346 (save-restriction |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
347 (narrow-to-region b e) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
348 (when (eq encoding 'B) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
349 ;; break into lines before encoding |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
350 (goto-char (point-min)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
351 (while (not (eobp)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
352 (goto-char (min (point-max) (+ 15 (point)))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
353 (unless (eobp) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
354 (insert ?\n)))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
355 (if (and (mm-multibyte-p) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
356 (mm-coding-system-p cs)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
357 (mm-encode-coding-region (point-min) (point-max) cs)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
358 (funcall (cdr (assq encoding rfc2047-encoding-function-alist)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
359 (point-min) (point-max)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
360 (goto-char (point-min)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
361 (while (not (eobp)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
362 (unless first |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
363 (insert ? )) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
364 (setq first nil) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
365 (insert start) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
366 (end-of-line) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
367 (insert "?=") |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
368 (forward-line 1)))))) |
31717 | 369 |
370 (defun rfc2047-fold-region (b e) | |
35985
b9c371244b90
(rfc2047-fold-region): Don't forward-char at EOB.
Dave Love <fx@gnu.org>
parents:
35838
diff
changeset
|
371 "Fold long lines in region B to E." |
31717 | 372 (save-restriction |
373 (narrow-to-region b e) | |
374 (goto-char (point-min)) | |
33304 | 375 (let ((break nil) |
376 (qword-break nil) | |
50881
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
377 (first t) |
33304 | 378 (bol (save-restriction |
379 (widen) | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
380 (mm-point-at-bol)))) |
31717 | 381 (while (not (eobp)) |
33304 | 382 (when (and (or break qword-break) (> (- (point) bol) 76)) |
383 (goto-char (or break qword-break)) | |
384 (setq break nil | |
385 qword-break nil) | |
50881
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
386 (if (looking-at "[ \t]") |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
387 (insert ?\n) |
35453
26726eff41ca
2001-01-21 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
34674
diff
changeset
|
388 (insert "\n ")) |
33304 | 389 (setq bol (1- (point))) |
390 ;; Don't break before the first non-LWSP characters. | |
391 (skip-chars-forward " \t") | |
35985
b9c371244b90
(rfc2047-fold-region): Don't forward-char at EOB.
Dave Love <fx@gnu.org>
parents:
35838
diff
changeset
|
392 (unless (eobp) (forward-char 1))) |
31717 | 393 (cond |
33304 | 394 ((eq (char-after) ?\n) |
395 (forward-char 1) | |
396 (setq bol (point) | |
397 break nil | |
398 qword-break nil) | |
399 (skip-chars-forward " \t") | |
400 (unless (or (eobp) (eq (char-after) ?\n)) | |
401 (forward-char 1))) | |
402 ((eq (char-after) ?\r) | |
403 (forward-char 1)) | |
31717 | 404 ((memq (char-after) '(? ?\t)) |
33304 | 405 (skip-chars-forward " \t") |
50881
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
406 (if first |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
407 ;; Don't break just after the header name. |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
408 (setq first nil) |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
409 (setq break (1- (point))))) |
33304 | 410 ((not break) |
411 (if (not (looking-at "=\\?[^=]")) | |
412 (if (eq (char-after) ?=) | |
413 (forward-char 1) | |
414 (skip-chars-forward "^ \t\n\r=")) | |
415 (setq qword-break (point)) | |
416 (skip-chars-forward "^ \t\n\r"))) | |
417 (t | |
418 (skip-chars-forward "^ \t\n\r")))) | |
419 (when (and (or break qword-break) (> (- (point) bol) 76)) | |
420 (goto-char (or break qword-break)) | |
421 (setq break nil | |
422 qword-break nil) | |
50881
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
423 (if (looking-at "[ \t]") |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
424 (insert ?\n) |
35453
26726eff41ca
2001-01-21 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
34674
diff
changeset
|
425 (insert "\n ")) |
33304 | 426 (setq bol (1- (point))) |
427 ;; Don't break before the first non-LWSP characters. | |
428 (skip-chars-forward " \t") | |
35985
b9c371244b90
(rfc2047-fold-region): Don't forward-char at EOB.
Dave Love <fx@gnu.org>
parents:
35838
diff
changeset
|
429 (unless (eobp) (forward-char 1)))))) |
33304 | 430 |
431 (defun rfc2047-unfold-region (b e) | |
35985
b9c371244b90
(rfc2047-fold-region): Don't forward-char at EOB.
Dave Love <fx@gnu.org>
parents:
35838
diff
changeset
|
432 "Unfold lines in region B to E." |
33304 | 433 (save-restriction |
434 (narrow-to-region b e) | |
435 (goto-char (point-min)) | |
436 (let ((bol (save-restriction | |
437 (widen) | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
438 (mm-point-at-bol))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
439 (eol (mm-point-at-eol)) |
33304 | 440 leading) |
441 (forward-line 1) | |
442 (while (not (eobp)) | |
50881
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
443 (if (and (looking-at "[ \t]") |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
444 (< (- (mm-point-at-eol) bol) 76)) |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
445 (delete-region eol (progn |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
446 (goto-char eol) |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
447 (skip-chars-forward "\r\n") |
b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
Dave Love <fx@gnu.org>
parents:
47951
diff
changeset
|
448 (point))) |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
449 (setq bol (mm-point-at-bol))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
450 (setq eol (mm-point-at-eol)) |
33304 | 451 (forward-line 1))))) |
31717 | 452 |
453 (defun rfc2047-b-encode-region (b e) | |
33304 | 454 "Base64-encode the header contained in region B to E." |
31717 | 455 (save-restriction |
456 (narrow-to-region (goto-char b) e) | |
457 (while (not (eobp)) | |
458 (base64-encode-region (point) (progn (end-of-line) (point)) t) | |
459 (if (and (bolp) (eolp)) | |
460 (delete-backward-char 1)) | |
461 (forward-line)))) | |
462 | |
463 (defun rfc2047-q-encode-region (b e) | |
33304 | 464 "Quoted-printable-encode the header in region B to E." |
31717 | 465 (save-excursion |
466 (save-restriction | |
467 (narrow-to-region (goto-char b) e) | |
33304 | 468 (let ((alist rfc2047-q-encoding-alist) |
469 (bol (save-restriction | |
470 (widen) | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
471 (mm-point-at-bol)))) |
31717 | 472 (while alist |
473 (when (looking-at (caar alist)) | |
474 (quoted-printable-encode-region b e nil (cdar alist)) | |
475 (subst-char-in-region (point-min) (point-max) ? ?_) | |
476 (setq alist nil)) | |
477 (pop alist)) | |
33304 | 478 ;; The size of QP encapsulation is about 20, so set limit to |
479 ;; 56=76-20. | |
480 (unless (< (- (point-max) (point-min)) 56) | |
481 ;; Don't break if it could fit in one line. | |
482 ;; Let rfc2047-encode-region break it later. | |
483 (goto-char (1+ (point-min))) | |
484 (while (and (not (bobp)) (not (eobp))) | |
485 (goto-char (min (point-max) (+ 56 bol))) | |
486 (search-backward "=" (- (point) 2) t) | |
487 (unless (or (bobp) (eobp)) | |
47951
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
488 (insert "\n") |
33304 | 489 (setq bol (point))))))))) |
31717 | 490 |
491 ;;; | |
492 ;;; Functions for decoding RFC2047 messages | |
493 ;;; | |
494 | |
47951
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
495 (defvar rfc2047-encoded-word-regexp |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
496 "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ +]+\\)\\?=") |
31717 | 497 |
498 (defun rfc2047-decode-region (start end) | |
499 "Decode MIME-encoded words in region between START and END." | |
500 (interactive "r") | |
501 (let ((case-fold-search t) | |
502 b e) | |
47951
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
503 (save-excursion |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
504 (save-restriction |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
505 (narrow-to-region start end) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
506 (goto-char (point-min)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
507 ;; Remove whitespace between encoded words. |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
508 (while (re-search-forward |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
509 (concat "\\(" rfc2047-encoded-word-regexp "\\)" |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
510 "\\(\n?[ \t]\\)+" |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
511 "\\(" rfc2047-encoded-word-regexp "\\)") |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
512 nil t) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
513 (delete-region (goto-char (match-end 1)) (match-beginning 6))) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
514 ;; Decode the encoded words. |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
515 (setq b (goto-char (point-min))) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
516 (while (re-search-forward rfc2047-encoded-word-regexp nil t) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
517 (setq e (match-beginning 0)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
518 (insert (rfc2047-parse-and-decode |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
519 (prog1 |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
520 (match-string 0) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
521 (delete-region (match-beginning 0) (match-end 0))))) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
522 (when (and (mm-multibyte-p) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
523 mail-parse-charset |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
524 (not (eq mail-parse-charset 'gnus-decoded))) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
525 (mm-decode-coding-region b e mail-parse-charset)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
526 (setq b (point))) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
527 (when (and (mm-multibyte-p) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
528 mail-parse-charset |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
529 (not (eq mail-parse-charset 'us-ascii)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
530 (not (eq mail-parse-charset 'gnus-decoded))) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
531 (mm-decode-coding-region b (point-max) mail-parse-charset)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
532 (rfc2047-unfold-region (point-min) (point-max)))))) |
31717 | 533 |
534 (defun rfc2047-decode-string (string) | |
535 "Decode the quoted-printable-encoded STRING and return the results." | |
536 (let ((m (mm-multibyte-p))) | |
537 (with-temp-buffer | |
538 (when m | |
539 (mm-enable-multibyte)) | |
540 (insert string) | |
541 (inline | |
542 (rfc2047-decode-region (point-min) (point-max))) | |
543 (buffer-string)))) | |
544 | |
47951
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
545 (defun rfc2047-parse-and-decode (word) |
31717 | 546 "Decode WORD and return it if it is an encoded word. |
547 Return WORD if not." | |
47951
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
548 (if (not (string-match rfc2047-encoded-word-regexp word)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
549 word |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
550 (or |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
551 (condition-case nil |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
552 (rfc2047-decode |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
553 (match-string 1 word) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
554 (upcase (match-string 2 word)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
555 (match-string 3 word)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
556 (error word)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
557 word))) |
31717 | 558 |
47951
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
559 (defun rfc2047-decode (charset encoding string) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
560 "Decode STRING from the given MIME CHARSET in the given ENCODING. |
31717 | 561 Valid ENCODINGs are \"B\" and \"Q\". |
33304 | 562 If your Emacs implementation can't decode CHARSET, return nil." |
31717 | 563 (if (stringp charset) |
564 (setq charset (intern (downcase charset)))) | |
33304 | 565 (if (or (not charset) |
31717 | 566 (eq 'gnus-all mail-parse-ignored-charsets) |
567 (memq 'gnus-all mail-parse-ignored-charsets) | |
568 (memq charset mail-parse-ignored-charsets)) | |
569 (setq charset mail-parse-charset)) | |
570 (let ((cs (mm-charset-to-coding-system charset))) | |
33304 | 571 (if (and (not cs) charset |
31717 | 572 (listp mail-parse-ignored-charsets) |
573 (memq 'gnus-unknown mail-parse-ignored-charsets)) | |
574 (setq cs (mm-charset-to-coding-system mail-parse-charset))) | |
575 (when cs | |
576 (when (and (eq cs 'ascii) | |
577 mail-parse-charset) | |
578 (setq cs mail-parse-charset)) | |
47951
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
579 ;; Ensure unibyte result in Emacs 20. |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
580 (let (default-enable-multibyte-characters) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
581 (with-temp-buffer |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
582 (mm-decode-coding-string |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
583 (cond |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
584 ((equal "B" encoding) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
585 (base64-decode-string string)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
586 ((equal "Q" encoding) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
587 (quoted-printable-decode-string |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
588 (mm-replace-chars-in-string string ?_ ? ))) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
589 (t (error "Invalid encoding: %s" encoding))) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
590 cs)))))) |
31717 | 591 |
592 (provide 'rfc2047) | |
593 | |
594 ;;; rfc2047.el ends here |