169 |
The buffer may be narrowed." |
The buffer may be narrowed." |
170 |
(require 'message) ; for message-posting-charset |
(require 'message) ; for message-posting-charset |
171 |
(let ((charsets |
(let ((charsets |
172 |
(mapcar |
(mm-find-mime-charset-region (point-min) (point-max)))) |
173 |
'mm-mime-charset |
(and charsets (not (equal charsets (list message-posting-charset)))))) |
|
(mm-find-charset-region (point-min) (point-max)))) |
|
|
(cs (list 'us-ascii (car message-posting-charset))) |
|
|
found) |
|
|
(while charsets |
|
|
(unless (memq (pop charsets) cs) |
|
|
(setq found t))) |
|
|
found)) |
|
174 |
|
|
175 |
(defun rfc2047-dissect-region (b e) |
(defun rfc2047-dissect-region (b e) |
176 |
"Dissect the region between B and E into words." |
"Dissect the region between B and E into words." |
177 |
(let ((word-chars "-A-Za-z0-9!*+/") |
(let ((word-chars "-A-Za-z0-9!*+/") |
178 |
;; Not using ietf-drums-specials-token makes life simple. |
;; Not using ietf-drums-specials-token makes life simple. |
179 |
mail-parse-mule-charset |
mail-parse-mule-charset |
180 |
words point current |
words point nonascii |
181 |
result word) |
result word) |
182 |
(save-restriction |
(save-restriction |
183 |
(narrow-to-region b e) |
(narrow-to-region b e) |
184 |
(goto-char (point-min)) |
(goto-char (point-min)) |
185 |
(skip-chars-forward "\000-\177") |
(skip-chars-forward "\000-\177") |
186 |
|
;; Fixme: This loop used to check charsets when it found |
187 |
|
;; non-ASCII characters. That's removed, since it doesn't make |
188 |
|
;; much sense in Emacs 22 and doesn't seem necessary in Emacs |
189 |
|
;; 21, even. I'm not sure exactly what it should be doing, and |
190 |
|
;; it needs another look, especially for efficiency's sake. -- fx |
191 |
(while (not (eobp)) |
(while (not (eobp)) |
192 |
(setq point (point)) |
(setq point (point) |
193 |
|
nonascii nil) |
194 |
(skip-chars-backward word-chars b) |
(skip-chars-backward word-chars b) |
195 |
(unless (eq b (point)) |
(unless (eq b (point)) |
196 |
(push (cons (buffer-substring b (point)) nil) words)) |
(push (cons (buffer-substring b (point)) nil) words)) |
197 |
(setq b (point)) |
(setq b (point) |
198 |
|
nonascii t) |
199 |
(goto-char point) |
(goto-char point) |
|
(setq current (mm-charset-after)) |
|
200 |
(forward-char 1) |
(forward-char 1) |
201 |
(skip-chars-forward word-chars) |
(skip-chars-forward word-chars) |
202 |
(while (and (not (eobp)) |
(while (not (eobp)) |
|
(eq (mm-charset-after) current)) |
|
203 |
(forward-char 1) |
(forward-char 1) |
204 |
(skip-chars-forward word-chars)) |
(skip-chars-forward word-chars)) |
205 |
(unless (eq b (point)) |
(unless (eq b (point)) |
206 |
(push (cons (buffer-substring b (point)) current) words)) |
(push (cons (buffer-substring b (point)) nonascii) words)) |
207 |
(setq b (point)) |
(setq b (point)) |
208 |
(skip-chars-forward "\000-\177")) |
(skip-chars-forward "\000-\177")) |
209 |
(unless (eq b (point)) |
(unless (eq b (point)) |
249 |
;; Insert blank between encoded words |
;; Insert blank between encoded words |
250 |
(if (eq (char-before) ?=) (insert " ")) |
(if (eq (char-before) ?=) (insert " ")) |
251 |
(rfc2047-encode (point) |
(rfc2047-encode (point) |
252 |
(progn (insert (car word)) (point)) |
(progn (insert (car word)) (point))))) |
|
(cdr word)))) |
|
253 |
(rfc2047-fold-region (point-min) (point-max))))) |
(rfc2047-fold-region (point-min) (point-max))))) |
254 |
|
|
255 |
(defun rfc2047-encode-string (string) |
(defun rfc2047-encode-string (string) |
259 |
(rfc2047-encode-region (point-min) (point-max)) |
(rfc2047-encode-region (point-min) (point-max)) |
260 |
(buffer-string))) |
(buffer-string))) |
261 |
|
|
262 |
(defun rfc2047-encode (b e charset) |
(defun rfc2047-encode (b e) |
263 |
"Encode the word in the region B to E with CHARSET." |
"Encode the word in the region B to E." |
264 |
(let* ((mime-charset (mm-mime-charset charset)) |
(let* ((buff (current-buffer)) |
265 |
(cs (mm-charset-to-coding-system mime-charset)) |
(mime-charset (with-temp-buffer |
266 |
|
(insert-buffer-substring buff b e) |
267 |
|
(mm-find-mime-charset-region b e))) |
268 |
|
(cs (if (> (length mime-charset) 1) |
269 |
|
(mm-charset-to-coding-system mime-charset) |
270 |
|
(error "Can't encode word: %s" (buffer-substring b e)))) |
271 |
(encoding (or (cdr (assq mime-charset |
(encoding (or (cdr (assq mime-charset |
272 |
rfc2047-charset-encoding-alist)) |
rfc2047-charset-encoding-alist)) |
273 |
'B)) |
'B)) |