Mercurial > emacs
annotate lisp/gnus/rfc2047.el @ 47985:9f3ecf5e3d65
(risky-local-variable-p): New function.
(compile-command): Use `stringp' for `safe-local-variable' prop.
(hack-one-local-variable): Use `risky-local-variable-p'.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Wed, 23 Oct 2002 17:38:44 +0000 |
parents | 9cd6016af581 |
children | b042c57894f8 d7ddb3e565de |
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 |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
2 ;; Copyright (C) 1998, 1999, 2000, 2002 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 |
42 '(("Newsgroups" . nil) | |
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)) | |
138 (if (and (eq (mm-body-7-or-8) '8bit) | |
139 (mm-multibyte-p) | |
140 (mm-coding-system-p | |
141 (car message-posting-charset))) | |
142 ;; 8 bit must be decoded. | |
143 ;; Is message-posting-charset a coding system? | |
33304 | 144 (mm-encode-coding-region |
145 (point-min) (point-max) | |
31717 | 146 (car message-posting-charset))) |
147 ;; We found something that may perhaps be encoded. | |
148 (setq method nil | |
149 alist rfc2047-header-encoding-alist) | |
150 (while (setq elem (pop alist)) | |
151 (when (or (and (stringp (car elem)) | |
152 (looking-at (car elem))) | |
153 (eq (car elem) t)) | |
154 (setq alist nil | |
155 method (cdr elem)))) | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
156 (goto-char (point-min)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
157 (re-search-forward "^[^:]+: *" nil t) |
31717 | 158 (cond |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
159 ((eq method 'address-mime) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
160 (rfc2047-encode-region (point) (point-max))) |
31717 | 161 ((eq method 'mime) |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
162 (let (rfc2047-encoding-type) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
163 (rfc2047-encode-region (point) (point-max)))) |
31717 | 164 ((eq method 'default) |
165 (if (and (featurep 'mule) | |
33815
61c7f3065929
(rfc2047-encode-message-header): Don't encode if
Dave Love <fx@gnu.org>
parents:
33304
diff
changeset
|
166 (if (boundp 'default-enable-multibyte-characters) |
61c7f3065929
(rfc2047-encode-message-header): Don't encode if
Dave Love <fx@gnu.org>
parents:
33304
diff
changeset
|
167 default-enable-multibyte-characters) |
31717 | 168 mail-parse-charset) |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
169 (mm-encode-coding-region (point) (point-max) |
31717 | 170 mail-parse-charset))) |
171 ((mm-coding-system-p method) | |
33815
61c7f3065929
(rfc2047-encode-message-header): Don't encode if
Dave Love <fx@gnu.org>
parents:
33304
diff
changeset
|
172 (if (and (featurep 'mule) |
61c7f3065929
(rfc2047-encode-message-header): Don't encode if
Dave Love <fx@gnu.org>
parents:
33304
diff
changeset
|
173 (if (boundp 'default-enable-multibyte-characters) |
61c7f3065929
(rfc2047-encode-message-header): Don't encode if
Dave Love <fx@gnu.org>
parents:
33304
diff
changeset
|
174 default-enable-multibyte-characters)) |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
175 (mm-encode-coding-region (point) (point-max) method))) |
31717 | 176 ;; Hm. |
177 (t))) | |
178 (goto-char (point-max))))))) | |
179 | |
35985
b9c371244b90
(rfc2047-fold-region): Don't forward-char at EOB.
Dave Love <fx@gnu.org>
parents:
35838
diff
changeset
|
180 ;; 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
|
181 ;; 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
|
182 (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
|
183 |
33304 | 184 (defun rfc2047-encodable-p () |
185 "Return non-nil if any characters in current buffer need encoding in headers. | |
186 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
|
187 (require 'message) ; for message-posting-charset |
31717 | 188 (let ((charsets |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
189 (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
|
190 (and charsets (not (equal charsets (list message-posting-charset)))))) |
31717 | 191 |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
192 ;; 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
|
193 ;; encoding. Double quotes are string delimiters, backslash is |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
194 ;; 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
|
195 ;; 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
|
196 ;; 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
|
197 ;; things differently. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
198 (defconst rfc2047-syntax-table |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
199 (let ((table (make-char-table 'syntax-table '(2)))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
200 (modify-syntax-entry ?\\ "\\" table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
201 (modify-syntax-entry ?\" "\"" table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
202 (modify-syntax-entry ?\( "." table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
203 (modify-syntax-entry ?\) "." table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
204 (modify-syntax-entry ?\< "." table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
205 (modify-syntax-entry ?\> "." table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
206 (modify-syntax-entry ?\[ "." table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
207 (modify-syntax-entry ?\] "." table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
208 (modify-syntax-entry ?: "." table) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
209 (modify-syntax-entry ?\; "." table) |
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 table)) |
31717 | 213 |
214 (defun rfc2047-encode-region (b e) | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
215 "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
|
216 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
|
217 Dynamically bind `rfc2047-encoding-type' to change that." |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
218 (save-restriction |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
219 (narrow-to-region b e) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
220 (if (eq 'mime rfc2047-encoding-type) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
221 ;; Simple case -- treat as single word. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
222 (progn |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
223 (goto-char (point-min)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
224 ;; Does it need encoding? |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
225 (skip-chars-forward "\000-\177" e) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
226 (unless (eobp) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
227 (rfc2047-encode b e))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
228 ;; `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
|
229 (with-syntax-table rfc2047-syntax-table |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
230 (let ((start (point)) ; start of current token |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
231 end ; end of current token |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
232 ;; Whether there's an encoded word before the current |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
233 ;; tpken, either immediately or separated by space. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
234 last-encoded) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
235 (goto-char (point-min)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
236 (condition-case nil ; in case of unbalanced quotes |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
237 ;; Look for rfc2822-style: sequences of atoms, quoted |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
238 ;; strings, specials, whitespace. (Specials mustn't be |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
239 ;; encoded.) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
240 (while (not (eobp)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
241 (setq start (point)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
242 ;; Skip whitespace. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
243 (unless (= 0 (skip-chars-forward " \t")) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
244 (setq start (point))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
245 (cond |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
246 ((not (char-after))) ; eob |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
247 ;; else token start |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
248 ((eq ?\" (char-syntax (char-after))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
249 ;; Quoted word. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
250 (forward-sexp) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
251 (setq end (point)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
252 ;; Does it need encoding? |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
253 (goto-char start) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
254 (skip-chars-forward "\000-\177" end) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
255 (if (= end (point)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
256 (setq last-encoded nil) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
257 ;; It needs encoding. Strip the quotes first, |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
258 ;; since encoded words can't occur in quotes. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
259 (goto-char end) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
260 (delete-backward-char 1) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
261 (goto-char start) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
262 (delete-char 1) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
263 (when last-encoded |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
264 ;; There was a preceding quoted word. We need |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
265 ;; to include any separating whitespace in this |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
266 ;; word to avoid it getting lost. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
267 (skip-chars-backward " \t") |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
268 ;; A space is needed between the encoded words. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
269 (insert ? ) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
270 (setq start (point) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
271 end (1+ end))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
272 ;; Adjust the end position for the deleted quotes. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
273 (rfc2047-encode start (- end 2)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
274 (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
|
275 ((eq ?. (char-syntax (char-after))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
276 ;; Skip other delimiters, but record that they've |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
277 ;; potentially separated quoted words. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
278 (forward-char) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
279 (setq last-encoded nil)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
280 (t ; normal token/whitespace sequence |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
281 ;; Find the end. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
282 (forward-word 1) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
283 (skip-chars-backward " \t") |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
284 (setq end (point)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
285 ;; Deal with encoding and leading space as for |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
286 ;; quoted words. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
287 (goto-char start) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
288 (skip-chars-forward "\000-\177" end) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
289 (if (= end (point)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
290 (setq last-encoded nil) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
291 (when last-encoded |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
292 (goto-char start) |
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 (insert ? ) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
295 (setq start (point) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
296 end (1+ end))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
297 (rfc2047-encode start end) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
298 (setq last-encoded t))))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
299 (error (error "Invalid data for rfc2047 encoding: %s" |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
300 (buffer-substring b e))))))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
301 (rfc2047-fold-region b (point)))) |
31717 | 302 |
303 (defun rfc2047-encode-string (string) | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
304 "Encode words in STRING. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
305 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
|
306 `rfc2047-special-chars')." |
31717 | 307 (with-temp-buffer |
308 (insert string) | |
309 (rfc2047-encode-region (point-min) (point-max)) | |
310 (buffer-string))) | |
311 | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
312 (defun rfc2047-encode (b e) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
313 "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
|
314 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
|
315 `rfc2047-special-chars')." |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
316 (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
|
317 (cs (if (> (length mime-charset) 1) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
318 ;; 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
|
319 ;; parts that can be encoded separately. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
320 (error "Can't rfc2047-encode `%s'" |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
321 (buffer-substring b e)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
322 (setq mime-charset (car mime-charset)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
323 (mm-charset-to-coding-system mime-charset))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
324 ;; Fixme: Better, calculate the number of non-ASCII |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
325 ;; characters, at least for 8-bit charsets. |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
326 (encoding (if (assq mime-charset |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
327 rfc2047-charset-encoding-alist) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
328 (cdr (assq mime-charset |
31717 | 329 rfc2047-charset-encoding-alist)) |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
330 'B)) |
31717 | 331 (start (concat |
332 "=?" (downcase (symbol-name mime-charset)) "?" | |
333 (downcase (symbol-name encoding)) "?")) | |
334 (first t)) | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
335 (if mime-charset |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
336 (save-restriction |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
337 (narrow-to-region b e) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
338 (when (eq encoding 'B) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
339 ;; break into lines before encoding |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
340 (goto-char (point-min)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
341 (while (not (eobp)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
342 (goto-char (min (point-max) (+ 15 (point)))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
343 (unless (eobp) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
344 (insert ?\n)))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
345 (if (and (mm-multibyte-p) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
346 (mm-coding-system-p cs)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
347 (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
|
348 (funcall (cdr (assq encoding rfc2047-encoding-function-alist)) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
349 (point-min) (point-max)) |
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 (unless first |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
353 (insert ? )) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
354 (setq first nil) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
355 (insert start) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
356 (end-of-line) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
357 (insert "?=") |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
358 (forward-line 1)))))) |
31717 | 359 |
360 (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
|
361 "Fold long lines in region B to E." |
31717 | 362 (save-restriction |
363 (narrow-to-region b e) | |
364 (goto-char (point-min)) | |
33304 | 365 (let ((break nil) |
366 (qword-break nil) | |
367 (bol (save-restriction | |
368 (widen) | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
369 (mm-point-at-bol)))) |
31717 | 370 (while (not (eobp)) |
33304 | 371 (when (and (or break qword-break) (> (- (point) bol) 76)) |
372 (goto-char (or break qword-break)) | |
373 (setq break nil | |
374 qword-break nil) | |
35453
26726eff41ca
2001-01-21 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
34674
diff
changeset
|
375 (if (looking-at " \t") |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
376 (insert ?\n) |
35453
26726eff41ca
2001-01-21 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
34674
diff
changeset
|
377 (insert "\n ")) |
33304 | 378 (setq bol (1- (point))) |
379 ;; Don't break before the first non-LWSP characters. | |
380 (skip-chars-forward " \t") | |
35985
b9c371244b90
(rfc2047-fold-region): Don't forward-char at EOB.
Dave Love <fx@gnu.org>
parents:
35838
diff
changeset
|
381 (unless (eobp) (forward-char 1))) |
31717 | 382 (cond |
33304 | 383 ((eq (char-after) ?\n) |
384 (forward-char 1) | |
385 (setq bol (point) | |
386 break nil | |
387 qword-break nil) | |
388 (skip-chars-forward " \t") | |
389 (unless (or (eobp) (eq (char-after) ?\n)) | |
390 (forward-char 1))) | |
391 ((eq (char-after) ?\r) | |
392 (forward-char 1)) | |
31717 | 393 ((memq (char-after) '(? ?\t)) |
33304 | 394 (skip-chars-forward " \t") |
395 (setq break (1- (point)))) | |
396 ((not break) | |
397 (if (not (looking-at "=\\?[^=]")) | |
398 (if (eq (char-after) ?=) | |
399 (forward-char 1) | |
400 (skip-chars-forward "^ \t\n\r=")) | |
401 (setq qword-break (point)) | |
402 (skip-chars-forward "^ \t\n\r"))) | |
403 (t | |
404 (skip-chars-forward "^ \t\n\r")))) | |
405 (when (and (or break qword-break) (> (- (point) bol) 76)) | |
406 (goto-char (or break qword-break)) | |
407 (setq break nil | |
408 qword-break nil) | |
35453
26726eff41ca
2001-01-21 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
34674
diff
changeset
|
409 (if (looking-at " \t") |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
410 (insert ?\n) |
35453
26726eff41ca
2001-01-21 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
34674
diff
changeset
|
411 (insert "\n ")) |
33304 | 412 (setq bol (1- (point))) |
413 ;; Don't break before the first non-LWSP characters. | |
414 (skip-chars-forward " \t") | |
35985
b9c371244b90
(rfc2047-fold-region): Don't forward-char at EOB.
Dave Love <fx@gnu.org>
parents:
35838
diff
changeset
|
415 (unless (eobp) (forward-char 1)))))) |
33304 | 416 |
417 (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
|
418 "Unfold lines in region B to E." |
33304 | 419 (save-restriction |
420 (narrow-to-region b e) | |
421 (goto-char (point-min)) | |
422 (let ((bol (save-restriction | |
423 (widen) | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
424 (mm-point-at-bol))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
425 (eol (mm-point-at-eol)) |
33304 | 426 leading) |
427 (forward-line 1) | |
428 (while (not (eobp)) | |
429 (looking-at "[ \t]*") | |
430 (setq leading (- (match-end 0) (match-beginning 0))) | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
431 (if (< (- (mm-point-at-eol) bol leading) 76) |
33304 | 432 (progn |
433 (goto-char eol) | |
434 (delete-region eol (progn | |
435 (skip-chars-forward "[ \t\n\r]+") | |
436 (1- (point))))) | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
437 (setq bol (mm-point-at-bol))) |
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
438 (setq eol (mm-point-at-eol)) |
33304 | 439 (forward-line 1))))) |
31717 | 440 |
441 (defun rfc2047-b-encode-region (b e) | |
33304 | 442 "Base64-encode the header contained in region B to E." |
31717 | 443 (save-restriction |
444 (narrow-to-region (goto-char b) e) | |
445 (while (not (eobp)) | |
446 (base64-encode-region (point) (progn (end-of-line) (point)) t) | |
447 (if (and (bolp) (eolp)) | |
448 (delete-backward-char 1)) | |
449 (forward-line)))) | |
450 | |
451 (defun rfc2047-q-encode-region (b e) | |
33304 | 452 "Quoted-printable-encode the header in region B to E." |
31717 | 453 (save-excursion |
454 (save-restriction | |
455 (narrow-to-region (goto-char b) e) | |
33304 | 456 (let ((alist rfc2047-q-encoding-alist) |
457 (bol (save-restriction | |
458 (widen) | |
47945
3915f2c7691e
(message-posting-charset): defvar when compiling.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
459 (mm-point-at-bol)))) |
31717 | 460 (while alist |
461 (when (looking-at (caar alist)) | |
462 (quoted-printable-encode-region b e nil (cdar alist)) | |
463 (subst-char-in-region (point-min) (point-max) ? ?_) | |
464 (setq alist nil)) | |
465 (pop alist)) | |
33304 | 466 ;; The size of QP encapsulation is about 20, so set limit to |
467 ;; 56=76-20. | |
468 (unless (< (- (point-max) (point-min)) 56) | |
469 ;; Don't break if it could fit in one line. | |
470 ;; Let rfc2047-encode-region break it later. | |
471 (goto-char (1+ (point-min))) | |
472 (while (and (not (bobp)) (not (eobp))) | |
473 (goto-char (min (point-max) (+ 56 bol))) | |
474 (search-backward "=" (- (point) 2) t) | |
475 (unless (or (bobp) (eobp)) | |
47951
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
476 (insert "\n") |
33304 | 477 (setq bol (point))))))))) |
31717 | 478 |
479 ;;; | |
480 ;;; Functions for decoding RFC2047 messages | |
481 ;;; | |
482 | |
47951
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
483 (defvar rfc2047-encoded-word-regexp |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
484 "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ +]+\\)\\?=") |
31717 | 485 |
486 (defun rfc2047-decode-region (start end) | |
487 "Decode MIME-encoded words in region between START and END." | |
488 (interactive "r") | |
489 (let ((case-fold-search t) | |
490 b e) | |
47951
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
491 (save-excursion |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
492 (save-restriction |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
493 (narrow-to-region start end) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
494 (goto-char (point-min)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
495 ;; Remove whitespace between encoded words. |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
496 (while (re-search-forward |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
497 (concat "\\(" rfc2047-encoded-word-regexp "\\)" |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
498 "\\(\n?[ \t]\\)+" |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
499 "\\(" rfc2047-encoded-word-regexp "\\)") |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
500 nil t) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
501 (delete-region (goto-char (match-end 1)) (match-beginning 6))) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
502 ;; Decode the encoded words. |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
503 (setq b (goto-char (point-min))) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
504 (while (re-search-forward rfc2047-encoded-word-regexp nil t) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
505 (setq e (match-beginning 0)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
506 (insert (rfc2047-parse-and-decode |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
507 (prog1 |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
508 (match-string 0) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
509 (delete-region (match-beginning 0) (match-end 0))))) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
510 (when (and (mm-multibyte-p) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
511 mail-parse-charset |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
512 (not (eq mail-parse-charset 'gnus-decoded))) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
513 (mm-decode-coding-region b e mail-parse-charset)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
514 (setq b (point))) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
515 (when (and (mm-multibyte-p) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
516 mail-parse-charset |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
517 (not (eq mail-parse-charset 'us-ascii)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
518 (not (eq mail-parse-charset 'gnus-decoded))) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
519 (mm-decode-coding-region b (point-max) mail-parse-charset)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
520 (rfc2047-unfold-region (point-min) (point-max)))))) |
31717 | 521 |
522 (defun rfc2047-decode-string (string) | |
523 "Decode the quoted-printable-encoded STRING and return the results." | |
524 (let ((m (mm-multibyte-p))) | |
525 (with-temp-buffer | |
526 (when m | |
527 (mm-enable-multibyte)) | |
528 (insert string) | |
529 (inline | |
530 (rfc2047-decode-region (point-min) (point-max))) | |
531 (buffer-string)))) | |
532 | |
47951
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
533 (defun rfc2047-parse-and-decode (word) |
31717 | 534 "Decode WORD and return it if it is an encoded word. |
535 Return WORD if not." | |
47951
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
536 (if (not (string-match rfc2047-encoded-word-regexp word)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
537 word |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
538 (or |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
539 (condition-case nil |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
540 (rfc2047-decode |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
541 (match-string 1 word) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
542 (upcase (match-string 2 word)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
543 (match-string 3 word)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
544 (error word)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
545 word))) |
31717 | 546 |
47951
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
547 (defun rfc2047-decode (charset encoding string) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
548 "Decode STRING from the given MIME CHARSET in the given ENCODING. |
31717 | 549 Valid ENCODINGs are \"B\" and \"Q\". |
33304 | 550 If your Emacs implementation can't decode CHARSET, return nil." |
31717 | 551 (if (stringp charset) |
552 (setq charset (intern (downcase charset)))) | |
33304 | 553 (if (or (not charset) |
31717 | 554 (eq 'gnus-all mail-parse-ignored-charsets) |
555 (memq 'gnus-all mail-parse-ignored-charsets) | |
556 (memq charset mail-parse-ignored-charsets)) | |
557 (setq charset mail-parse-charset)) | |
558 (let ((cs (mm-charset-to-coding-system charset))) | |
33304 | 559 (if (and (not cs) charset |
31717 | 560 (listp mail-parse-ignored-charsets) |
561 (memq 'gnus-unknown mail-parse-ignored-charsets)) | |
562 (setq cs (mm-charset-to-coding-system mail-parse-charset))) | |
563 (when cs | |
564 (when (and (eq cs 'ascii) | |
565 mail-parse-charset) | |
566 (setq cs mail-parse-charset)) | |
47951
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
567 ;; Ensure unibyte result in Emacs 20. |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
568 (let (default-enable-multibyte-characters) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
569 (with-temp-buffer |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
570 (mm-decode-coding-string |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
571 (cond |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
572 ((equal "B" encoding) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
573 (base64-decode-string string)) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
574 ((equal "Q" encoding) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
575 (quoted-printable-decode-string |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
576 (mm-replace-chars-in-string string ?_ ? ))) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
577 (t (error "Invalid encoding: %s" encoding))) |
9cd6016af581
Revert decoding changes temporarily.
Dave Love <fx@gnu.org>
parents:
47945
diff
changeset
|
578 cs)))))) |
31717 | 579 |
580 (provide 'rfc2047) | |
581 | |
582 ;;; rfc2047.el ends here |