2001-07-15 17:42:53 +00:00
|
|
|
;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages
|
2004-09-04 13:13:48 +00:00
|
|
|
;; Copyright (C) 1998, 1999, 2000, 2002, 2003 Free Software Foundation, Inc.
|
2000-09-19 13:40:08 +00:00
|
|
|
|
|
|
|
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
|
|
|
|
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
|
|
|
|
;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
|
|
|
;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
|
;; any later version.
|
|
|
|
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
;; GNU General Public License for more details.
|
|
|
|
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
|
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
|
;; Boston, MA 02111-1307, USA.
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
2000-12-18 12:54:50 +00:00
|
|
|
;; RFC 2047 is "MIME (Multipurpose Internet Mail Extensions) Part
|
|
|
|
;; Three: Message Header Extensions for Non-ASCII Text".
|
|
|
|
|
2000-09-19 13:40:08 +00:00
|
|
|
;;; Code:
|
|
|
|
|
2002-10-18 10:52:56 +00:00
|
|
|
(eval-when-compile
|
|
|
|
(require 'cl)
|
2004-09-04 13:13:48 +00:00
|
|
|
(defvar message-posting-charset)
|
|
|
|
(unless (fboundp 'with-syntax-table) ; not in Emacs 20
|
|
|
|
(defmacro with-syntax-table (table &rest body)
|
|
|
|
"Evaluate BODY with syntax table of current buffer set to TABLE.
|
|
|
|
The syntax table of the current buffer is saved, BODY is evaluated, and the
|
|
|
|
saved table is restored, even in case of an abnormal exit.
|
|
|
|
Value is what BODY returns."
|
|
|
|
(let ((old-table (make-symbol "table"))
|
|
|
|
(old-buffer (make-symbol "buffer")))
|
|
|
|
`(let ((,old-table (syntax-table))
|
|
|
|
(,old-buffer (current-buffer)))
|
|
|
|
(unwind-protect
|
|
|
|
(progn
|
|
|
|
(set-syntax-table ,table)
|
|
|
|
,@body)
|
|
|
|
(save-current-buffer
|
|
|
|
(set-buffer ,old-buffer)
|
|
|
|
(set-syntax-table ,old-table))))))))
|
2000-09-19 13:40:08 +00:00
|
|
|
|
|
|
|
(require 'qp)
|
|
|
|
(require 'mm-util)
|
2002-10-18 10:52:56 +00:00
|
|
|
;; Fixme: Avoid this (used for mail-parse-charset) mm dependence on gnus.
|
2000-09-19 13:40:08 +00:00
|
|
|
(require 'mail-prsvr)
|
2000-11-08 15:45:55 +00:00
|
|
|
(require 'base64)
|
|
|
|
(autoload 'mm-body-7-or-8 "mm-bodies")
|
2000-11-01 19:07:36 +00:00
|
|
|
|
2004-09-04 13:13:48 +00:00
|
|
|
(eval-and-compile
|
|
|
|
;; Avoid gnus-util for mm- code.
|
|
|
|
(defalias 'rfc2047-point-at-bol
|
|
|
|
(if (fboundp 'point-at-bol)
|
|
|
|
'point-at-bol
|
|
|
|
'line-beginning-position))
|
|
|
|
|
|
|
|
(defalias 'rfc2047-point-at-eol
|
|
|
|
(if (fboundp 'point-at-eol)
|
|
|
|
'point-at-eol
|
|
|
|
'line-end-position)))
|
|
|
|
|
2000-09-19 13:40:08 +00:00
|
|
|
(defvar rfc2047-header-encoding-alist
|
2004-09-04 13:13:48 +00:00
|
|
|
'(("Newsgroups" . nil)
|
|
|
|
("Followup-To" . nil)
|
2000-09-19 13:40:08 +00:00
|
|
|
("Message-ID" . nil)
|
2004-09-04 13:13:48 +00:00
|
|
|
("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\
|
|
|
|
\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\)" . address-mime)
|
2000-09-19 13:40:08 +00:00
|
|
|
(t . mime))
|
|
|
|
"*Header/encoding method alist.
|
|
|
|
The list is traversed sequentially. The keys can either be
|
2000-11-08 15:45:55 +00:00
|
|
|
header regexps or t.
|
2000-09-19 13:40:08 +00:00
|
|
|
|
|
|
|
The values can be:
|
|
|
|
|
|
|
|
1) nil, in which case no encoding is done;
|
|
|
|
2) `mime', in which case the header will be encoded according to RFC2047;
|
2002-10-18 10:52:56 +00:00
|
|
|
3) `address-mime', like `mime', but takes account of the rules for address
|
|
|
|
fields (where quoted strings and comments must be treated separately);
|
|
|
|
4) a charset, in which case it will be encoded as that charset;
|
|
|
|
5) `default', in which case the field will be encoded as the rest
|
2000-09-19 13:40:08 +00:00
|
|
|
of the article.")
|
|
|
|
|
|
|
|
(defvar rfc2047-charset-encoding-alist
|
|
|
|
'((us-ascii . nil)
|
|
|
|
(iso-8859-1 . Q)
|
|
|
|
(iso-8859-2 . Q)
|
|
|
|
(iso-8859-3 . Q)
|
|
|
|
(iso-8859-4 . Q)
|
|
|
|
(iso-8859-5 . B)
|
|
|
|
(koi8-r . B)
|
2002-10-18 10:52:56 +00:00
|
|
|
(iso-8859-7 . B)
|
|
|
|
(iso-8859-8 . B)
|
2000-09-19 13:40:08 +00:00
|
|
|
(iso-8859-9 . Q)
|
2000-11-08 15:45:55 +00:00
|
|
|
(iso-8859-14 . Q)
|
|
|
|
(iso-8859-15 . Q)
|
2000-09-19 13:40:08 +00:00
|
|
|
(iso-2022-jp . B)
|
|
|
|
(iso-2022-kr . B)
|
|
|
|
(gb2312 . B)
|
2001-02-02 03:15:52 +00:00
|
|
|
(big5 . B)
|
|
|
|
(cn-big5 . B)
|
2000-09-19 13:40:08 +00:00
|
|
|
(cn-gb . B)
|
|
|
|
(cn-gb-2312 . B)
|
|
|
|
(euc-kr . B)
|
|
|
|
(iso-2022-jp-2 . B)
|
2004-09-04 13:13:48 +00:00
|
|
|
(iso-2022-int-1 . B)
|
|
|
|
(viscii . Q))
|
2000-09-19 13:40:08 +00:00
|
|
|
"Alist of MIME charsets to RFC2047 encodings.
|
2002-10-18 10:52:56 +00:00
|
|
|
Valid encodings are nil, `Q' and `B'. These indicate binary (no) encoding,
|
|
|
|
quoted-printable and base64 respectively.")
|
2000-09-19 13:40:08 +00:00
|
|
|
|
|
|
|
(defvar rfc2047-encoding-function-alist
|
|
|
|
'((Q . rfc2047-q-encode-region)
|
|
|
|
(B . rfc2047-b-encode-region)
|
|
|
|
(nil . ignore))
|
|
|
|
"Alist of RFC2047 encodings to encoding functions.")
|
|
|
|
|
|
|
|
;;;
|
|
|
|
;;; Functions for encoding RFC2047 messages
|
|
|
|
;;;
|
|
|
|
|
2004-09-27 07:44:44 +00:00
|
|
|
(defun rfc2047-qp-or-base64 ()
|
|
|
|
"Return the type with which to encode the buffer.
|
|
|
|
This is either `base64' or `quoted-printable'."
|
|
|
|
(save-excursion
|
|
|
|
(let ((limit (min (point-max) (+ 2000 (point-min))))
|
|
|
|
(n8bit 0))
|
|
|
|
(goto-char (point-min))
|
|
|
|
(skip-chars-forward "\x20-\x7f\r\n\t" limit)
|
|
|
|
(while (< (point) limit)
|
|
|
|
(incf n8bit)
|
|
|
|
(forward-char 1)
|
|
|
|
(skip-chars-forward "\x20-\x7f\r\n\t" limit))
|
|
|
|
(if (or (< (* 6 n8bit) (- limit (point-min)))
|
|
|
|
;; Don't base64, say, a short line with a single
|
|
|
|
;; non-ASCII char when splitting parts by charset.
|
|
|
|
(= n8bit 1))
|
|
|
|
'quoted-printable
|
|
|
|
'base64))))
|
|
|
|
|
2000-09-19 13:40:08 +00:00
|
|
|
(defun rfc2047-narrow-to-field ()
|
|
|
|
"Narrow the buffer to the header on the current line."
|
|
|
|
(beginning-of-line)
|
|
|
|
(narrow-to-region
|
|
|
|
(point)
|
|
|
|
(progn
|
|
|
|
(forward-line 1)
|
|
|
|
(if (re-search-forward "^[^ \n\t]" nil t)
|
2004-09-04 13:13:48 +00:00
|
|
|
(rfc2047-point-at-bol)
|
2000-09-19 13:40:08 +00:00
|
|
|
(point-max))))
|
|
|
|
(goto-char (point-min)))
|
|
|
|
|
2004-09-04 13:13:48 +00:00
|
|
|
(defun rfc2047-field-value ()
|
|
|
|
"Return the value of the field at point."
|
|
|
|
(save-excursion
|
|
|
|
(save-restriction
|
|
|
|
(rfc2047-narrow-to-field)
|
|
|
|
(re-search-forward ":[ \t\n]*" nil t)
|
|
|
|
(buffer-substring (point) (point-max)))))
|
|
|
|
|
2002-10-18 10:52:56 +00:00
|
|
|
(defvar rfc2047-encoding-type 'address-mime
|
|
|
|
"The type of encoding done by `rfc2047-encode-region'.
|
|
|
|
This should be dynamically bound around calls to
|
|
|
|
`rfc2047-encode-region' to either `mime' or `address-mime'. See
|
|
|
|
`rfc2047-header-encoding-alist', for definitions.")
|
|
|
|
|
2000-09-19 13:40:08 +00:00
|
|
|
(defun rfc2047-encode-message-header ()
|
|
|
|
"Encode the message header according to `rfc2047-header-encoding-alist'.
|
|
|
|
Should be called narrowed to the head of the message."
|
|
|
|
(interactive "*")
|
|
|
|
(save-excursion
|
|
|
|
(goto-char (point-min))
|
|
|
|
(let (alist elem method)
|
|
|
|
(while (not (eobp))
|
|
|
|
(save-restriction
|
|
|
|
(rfc2047-narrow-to-field)
|
|
|
|
(if (not (rfc2047-encodable-p))
|
2003-05-07 17:27:31 +00:00
|
|
|
(prog1
|
|
|
|
(if (and (eq (mm-body-7-or-8) '8bit)
|
|
|
|
(mm-multibyte-p)
|
|
|
|
(mm-coding-system-p
|
|
|
|
(car message-posting-charset)))
|
|
|
|
;; 8 bit must be decoded.
|
|
|
|
(mm-encode-coding-region
|
|
|
|
(point-min) (point-max)
|
|
|
|
(mm-charset-to-coding-system
|
|
|
|
(car message-posting-charset))))
|
|
|
|
;; No encoding necessary, but folding is nice
|
|
|
|
(rfc2047-fold-region
|
|
|
|
(save-excursion
|
|
|
|
(goto-char (point-min))
|
|
|
|
(skip-chars-forward "^:")
|
|
|
|
(when (looking-at ": ")
|
|
|
|
(forward-char 2))
|
|
|
|
(point))
|
|
|
|
(point-max)))
|
2000-09-19 13:40:08 +00:00
|
|
|
;; We found something that may perhaps be encoded.
|
|
|
|
(setq method nil
|
|
|
|
alist rfc2047-header-encoding-alist)
|
|
|
|
(while (setq elem (pop alist))
|
|
|
|
(when (or (and (stringp (car elem))
|
|
|
|
(looking-at (car elem)))
|
|
|
|
(eq (car elem) t))
|
|
|
|
(setq alist nil
|
|
|
|
method (cdr elem))))
|
2002-10-18 10:52:56 +00:00
|
|
|
(goto-char (point-min))
|
|
|
|
(re-search-forward "^[^:]+: *" nil t)
|
2000-09-19 13:40:08 +00:00
|
|
|
(cond
|
2002-10-18 10:52:56 +00:00
|
|
|
((eq method 'address-mime)
|
|
|
|
(rfc2047-encode-region (point) (point-max)))
|
2000-09-19 13:40:08 +00:00
|
|
|
((eq method 'mime)
|
2004-09-04 13:13:48 +00:00
|
|
|
(let ((rfc2047-encoding-type 'mime))
|
2002-10-18 10:52:56 +00:00
|
|
|
(rfc2047-encode-region (point) (point-max))))
|
2000-09-19 13:40:08 +00:00
|
|
|
((eq method 'default)
|
|
|
|
(if (and (featurep 'mule)
|
2000-11-23 16:09:21 +00:00
|
|
|
(if (boundp 'default-enable-multibyte-characters)
|
|
|
|
default-enable-multibyte-characters)
|
2000-09-19 13:40:08 +00:00
|
|
|
mail-parse-charset)
|
2002-10-18 10:52:56 +00:00
|
|
|
(mm-encode-coding-region (point) (point-max)
|
2000-09-19 13:40:08 +00:00
|
|
|
mail-parse-charset)))
|
2004-09-04 13:13:48 +00:00
|
|
|
;; We get this when CC'ing messsages to newsgroups with
|
|
|
|
;; 8-bit names. The group name mail copy just got
|
|
|
|
;; unconditionally encoded. Previously, it would ask
|
|
|
|
;; whether to encode, which was quite confusing for the
|
|
|
|
;; user. If the new behaviour is wrong, tell me. I have
|
|
|
|
;; left the old code commented out below.
|
|
|
|
;; -- Per Abrahamsen <abraham@dina.kvl.dk> Date: 2001-10-07.
|
|
|
|
;; Modified by Dave Love, with the commented-out code changed
|
|
|
|
;; in accordance with changes elsewhere.
|
|
|
|
((null method)
|
|
|
|
(rfc2047-encode-region (point) (point-max)))
|
|
|
|
;;; ((null method)
|
|
|
|
;;; (if (or (message-options-get
|
|
|
|
;;; 'rfc2047-encode-message-header-encode-any)
|
|
|
|
;;; (message-options-set
|
|
|
|
;;; 'rfc2047-encode-message-header-encode-any
|
|
|
|
;;; (y-or-n-p
|
|
|
|
;;; "Some texts are not encoded. Encode anyway?")))
|
|
|
|
;;; (rfc2047-encode-region (point-min) (point-max))
|
|
|
|
;;; (error "Cannot send unencoded text")))
|
2000-09-19 13:40:08 +00:00
|
|
|
((mm-coding-system-p method)
|
2000-11-23 16:09:21 +00:00
|
|
|
(if (and (featurep 'mule)
|
|
|
|
(if (boundp 'default-enable-multibyte-characters)
|
|
|
|
default-enable-multibyte-characters))
|
2002-10-18 10:52:56 +00:00
|
|
|
(mm-encode-coding-region (point) (point-max) method)))
|
2000-09-19 13:40:08 +00:00
|
|
|
;; Hm.
|
|
|
|
(t)))
|
|
|
|
(goto-char (point-max)))))))
|
|
|
|
|
2001-02-08 19:26:36 +00:00
|
|
|
;; Fixme: This, and the require below may not be the Right Thing, but
|
|
|
|
;; should be safe just before release. -- fx 2001-02-08
|
|
|
|
(eval-when-compile (defvar message-posting-charset))
|
|
|
|
|
2000-11-08 15:45:55 +00:00
|
|
|
(defun rfc2047-encodable-p ()
|
|
|
|
"Return non-nil if any characters in current buffer need encoding in headers.
|
|
|
|
The buffer may be narrowed."
|
2001-02-08 19:26:36 +00:00
|
|
|
(require 'message) ; for message-posting-charset
|
2000-09-19 13:40:08 +00:00
|
|
|
(let ((charsets
|
2002-10-18 10:52:56 +00:00
|
|
|
(mm-find-mime-charset-region (point-min) (point-max))))
|
2004-09-04 13:13:48 +00:00
|
|
|
(and charsets
|
|
|
|
(not (equal charsets (list (car message-posting-charset)))))))
|
2002-10-18 10:52:56 +00:00
|
|
|
|
|
|
|
;; Use this syntax table when parsing into regions that may need
|
|
|
|
;; encoding. Double quotes are string delimiters, backslash is
|
|
|
|
;; character quoting, and all other RFC 2822 special characters are
|
|
|
|
;; treated as punctuation so we can use forward-sexp/forward-word to
|
|
|
|
;; skip to the end of regions appropriately. Nb. ietf-drums does
|
|
|
|
;; things differently.
|
|
|
|
(defconst rfc2047-syntax-table
|
2004-09-04 13:13:48 +00:00
|
|
|
;; (make-char-table 'syntax-table '(2)) only works in Emacs.
|
|
|
|
(let ((table (make-syntax-table)))
|
|
|
|
;; The following is done to work for setting all elements of the table
|
|
|
|
;; in Emacs 21 and 22 and XEmacs; it appears to be the cleanest way.
|
|
|
|
;; Play safe and don't assume the form of the word syntax entry --
|
|
|
|
;; copy it from ?a.
|
|
|
|
(if (fboundp 'set-char-table-range) ; Emacs
|
|
|
|
(funcall (intern "set-char-table-range")
|
|
|
|
table t (aref (standard-syntax-table) ?a))
|
|
|
|
(if (fboundp 'put-char-table)
|
|
|
|
(if (fboundp 'get-char-table) ; warning avoidance
|
|
|
|
(put-char-table t (get-char-table ?a (standard-syntax-table))
|
|
|
|
table))))
|
2002-10-18 10:52:56 +00:00
|
|
|
(modify-syntax-entry ?\\ "\\" table)
|
|
|
|
(modify-syntax-entry ?\" "\"" table)
|
|
|
|
(modify-syntax-entry ?\( "." table)
|
|
|
|
(modify-syntax-entry ?\) "." table)
|
|
|
|
(modify-syntax-entry ?\< "." table)
|
|
|
|
(modify-syntax-entry ?\> "." table)
|
|
|
|
(modify-syntax-entry ?\[ "." table)
|
|
|
|
(modify-syntax-entry ?\] "." table)
|
|
|
|
(modify-syntax-entry ?: "." table)
|
|
|
|
(modify-syntax-entry ?\; "." table)
|
|
|
|
(modify-syntax-entry ?, "." table)
|
|
|
|
(modify-syntax-entry ?@ "." table)
|
|
|
|
table))
|
2000-09-19 13:40:08 +00:00
|
|
|
|
|
|
|
(defun rfc2047-encode-region (b e)
|
2002-10-18 10:52:56 +00:00
|
|
|
"Encode words in region B to E that need encoding.
|
|
|
|
By default, the region is treated as containing RFC2822 addresses.
|
|
|
|
Dynamically bind `rfc2047-encoding-type' to change that."
|
|
|
|
(save-restriction
|
|
|
|
(narrow-to-region b e)
|
|
|
|
(if (eq 'mime rfc2047-encoding-type)
|
2004-09-04 13:13:48 +00:00
|
|
|
;; Simple case. Treat as single word after any initial ASCII
|
|
|
|
;; part and before any tailing ASCII part. The leading ASCII
|
|
|
|
;; is relevant for instance in Subject headers with `Re:' for
|
|
|
|
;; interoperability with non-MIME clients, and we might as
|
|
|
|
;; well avoid the tail too.
|
2002-10-18 10:52:56 +00:00
|
|
|
(progn
|
|
|
|
(goto-char (point-min))
|
|
|
|
;; Does it need encoding?
|
2004-09-04 13:13:48 +00:00
|
|
|
(skip-chars-forward "\000-\177")
|
2002-10-18 10:52:56 +00:00
|
|
|
(unless (eobp)
|
2004-09-04 13:13:48 +00:00
|
|
|
(skip-chars-backward "^ \n") ; beginning of space-delimited word
|
|
|
|
(rfc2047-encode (point) (progn
|
|
|
|
(goto-char e)
|
|
|
|
(skip-chars-backward "\000-\177")
|
|
|
|
(skip-chars-forward "^ \n")
|
|
|
|
;; end of space-delimited word
|
|
|
|
(point)))))
|
2002-10-18 10:52:56 +00:00
|
|
|
;; `address-mime' case -- take care of quoted words, comments.
|
|
|
|
(with-syntax-table rfc2047-syntax-table
|
2004-09-04 13:13:48 +00:00
|
|
|
(let ((start) ; start of current token
|
2002-10-18 10:52:56 +00:00
|
|
|
end ; end of current token
|
|
|
|
;; Whether there's an encoded word before the current
|
2003-05-07 17:27:31 +00:00
|
|
|
;; token, either immediately or separated by space.
|
2002-10-18 10:52:56 +00:00
|
|
|
last-encoded)
|
|
|
|
(goto-char (point-min))
|
2004-09-04 13:13:48 +00:00
|
|
|
(condition-case nil ; in case of unbalanced quotes
|
2002-10-18 10:52:56 +00:00
|
|
|
;; Look for rfc2822-style: sequences of atoms, quoted
|
|
|
|
;; strings, specials, whitespace. (Specials mustn't be
|
|
|
|
;; encoded.)
|
|
|
|
(while (not (eobp))
|
|
|
|
(setq start (point))
|
|
|
|
;; Skip whitespace.
|
2003-05-07 17:27:31 +00:00
|
|
|
(unless (= 0 (skip-chars-forward " \t\n"))
|
2002-10-18 10:52:56 +00:00
|
|
|
(setq start (point)))
|
|
|
|
(cond
|
|
|
|
((not (char-after))) ; eob
|
|
|
|
;; else token start
|
|
|
|
((eq ?\" (char-syntax (char-after)))
|
|
|
|
;; Quoted word.
|
|
|
|
(forward-sexp)
|
|
|
|
(setq end (point))
|
|
|
|
;; Does it need encoding?
|
|
|
|
(goto-char start)
|
|
|
|
(skip-chars-forward "\000-\177" end)
|
|
|
|
(if (= end (point))
|
|
|
|
(setq last-encoded nil)
|
|
|
|
;; It needs encoding. Strip the quotes first,
|
|
|
|
;; since encoded words can't occur in quotes.
|
|
|
|
(goto-char end)
|
|
|
|
(delete-backward-char 1)
|
|
|
|
(goto-char start)
|
|
|
|
(delete-char 1)
|
|
|
|
(when last-encoded
|
|
|
|
;; There was a preceding quoted word. We need
|
|
|
|
;; to include any separating whitespace in this
|
|
|
|
;; word to avoid it getting lost.
|
|
|
|
(skip-chars-backward " \t")
|
|
|
|
;; A space is needed between the encoded words.
|
|
|
|
(insert ? )
|
|
|
|
(setq start (point)
|
|
|
|
end (1+ end)))
|
|
|
|
;; Adjust the end position for the deleted quotes.
|
|
|
|
(rfc2047-encode start (- end 2))
|
|
|
|
(setq last-encoded t))) ; record that it was encoded
|
|
|
|
((eq ?. (char-syntax (char-after)))
|
|
|
|
;; Skip other delimiters, but record that they've
|
|
|
|
;; potentially separated quoted words.
|
|
|
|
(forward-char)
|
|
|
|
(setq last-encoded nil))
|
|
|
|
(t ; normal token/whitespace sequence
|
|
|
|
;; Find the end.
|
|
|
|
(forward-word 1)
|
|
|
|
(skip-chars-backward " \t")
|
|
|
|
(setq end (point))
|
|
|
|
;; Deal with encoding and leading space as for
|
|
|
|
;; quoted words.
|
|
|
|
(goto-char start)
|
|
|
|
(skip-chars-forward "\000-\177" end)
|
|
|
|
(if (= end (point))
|
|
|
|
(setq last-encoded nil)
|
|
|
|
(when last-encoded
|
|
|
|
(goto-char start)
|
|
|
|
(skip-chars-backward " \t")
|
|
|
|
(insert ? )
|
|
|
|
(setq start (point)
|
|
|
|
end (1+ end)))
|
|
|
|
(rfc2047-encode start end)
|
|
|
|
(setq last-encoded t)))))
|
2004-09-04 13:13:48 +00:00
|
|
|
(error
|
|
|
|
(error "Invalid data for rfc2047 encoding: %s"
|
|
|
|
(buffer-substring b e)))))))
|
2002-10-18 10:52:56 +00:00
|
|
|
(rfc2047-fold-region b (point))))
|
2000-09-19 13:40:08 +00:00
|
|
|
|
|
|
|
(defun rfc2047-encode-string (string)
|
2002-10-18 10:52:56 +00:00
|
|
|
"Encode words in STRING.
|
|
|
|
By default, the string is treated as containing addresses (see
|
2004-09-04 13:13:48 +00:00
|
|
|
`rfc2047-encoding-type')."
|
2000-09-19 13:40:08 +00:00
|
|
|
(with-temp-buffer
|
|
|
|
(insert string)
|
|
|
|
(rfc2047-encode-region (point-min) (point-max))
|
|
|
|
(buffer-string)))
|
|
|
|
|
2002-10-18 10:52:56 +00:00
|
|
|
(defun rfc2047-encode (b e)
|
|
|
|
"Encode the word(s) in the region B to E.
|
|
|
|
By default, the region is treated as containing addresses (see
|
2004-09-04 13:13:48 +00:00
|
|
|
`rfc2047-encoding-type')."
|
2002-10-18 10:52:56 +00:00
|
|
|
(let* ((mime-charset (mm-find-mime-charset-region b e))
|
|
|
|
(cs (if (> (length mime-charset) 1)
|
|
|
|
;; Fixme: Instead of this, try to break region into
|
|
|
|
;; parts that can be encoded separately.
|
|
|
|
(error "Can't rfc2047-encode `%s'"
|
|
|
|
(buffer-substring b e))
|
|
|
|
(setq mime-charset (car mime-charset))
|
|
|
|
(mm-charset-to-coding-system mime-charset)))
|
|
|
|
;; Fixme: Better, calculate the number of non-ASCII
|
|
|
|
;; characters, at least for 8-bit charsets.
|
2004-09-04 13:13:48 +00:00
|
|
|
(encoding (or (cdr (assq mime-charset
|
2000-09-19 13:40:08 +00:00
|
|
|
rfc2047-charset-encoding-alist))
|
2004-09-04 13:13:48 +00:00
|
|
|
;; For the charsets that don't have a preferred
|
|
|
|
;; encoding, choose the one that's shorter.
|
|
|
|
(save-restriction
|
|
|
|
(narrow-to-region b e)
|
2004-09-27 07:44:44 +00:00
|
|
|
(if (eq (rfc2047-qp-or-base64) 'base64)
|
2004-09-04 13:13:48 +00:00
|
|
|
'B
|
|
|
|
'Q))))
|
2000-09-19 13:40:08 +00:00
|
|
|
(start (concat
|
|
|
|
"=?" (downcase (symbol-name mime-charset)) "?"
|
|
|
|
(downcase (symbol-name encoding)) "?"))
|
2004-09-04 13:13:48 +00:00
|
|
|
(factor (case mime-charset
|
|
|
|
((iso-8859-5 iso-8859-7 iso-8859-8 koi8-r) 1)
|
|
|
|
((big5 gb2312 euc-kr) 2)
|
|
|
|
(utf-8 4)
|
|
|
|
(t 8)))
|
|
|
|
(pre (- b (save-restriction
|
|
|
|
(widen)
|
|
|
|
(rfc2047-point-at-bol))))
|
|
|
|
;; encoded-words must not be longer than 75 characters,
|
|
|
|
;; including charset, encoding etc. This leaves us with
|
|
|
|
;; 75 - (length start) - 2 - 2 characters. The last 2 is for
|
|
|
|
;; possible base64 padding. In the worst case (iso-2022-*)
|
|
|
|
;; each character expands to 8 bytes which is expanded by a
|
|
|
|
;; factor of 4/3 by base64 encoding.
|
|
|
|
(length (floor (- 75 (length start) 4) (* factor (/ 4.0 3.0))))
|
|
|
|
;; Limit line length to 76 characters.
|
|
|
|
(length1 (max 1 (floor (- 76 (length start) 4 pre)
|
|
|
|
(* factor (/ 4.0 3.0)))))
|
2000-09-19 13:40:08 +00:00
|
|
|
(first t))
|
2002-10-18 10:52:56 +00:00
|
|
|
(if mime-charset
|
|
|
|
(save-restriction
|
|
|
|
(narrow-to-region b e)
|
|
|
|
(when (eq encoding 'B)
|
|
|
|
;; break into lines before encoding
|
|
|
|
(goto-char (point-min))
|
|
|
|
(while (not (eobp))
|
2004-09-04 13:13:48 +00:00
|
|
|
(if first
|
|
|
|
(progn
|
|
|
|
(goto-char (min (point-max) (+ length1 (point))))
|
|
|
|
(setq first nil))
|
|
|
|
(goto-char (min (point-max) (+ length (point)))))
|
2002-10-18 10:52:56 +00:00
|
|
|
(unless (eobp)
|
2004-09-04 13:13:48 +00:00
|
|
|
(insert ?\n)))
|
|
|
|
(setq first t))
|
2002-10-18 10:52:56 +00:00
|
|
|
(if (and (mm-multibyte-p)
|
|
|
|
(mm-coding-system-p cs))
|
|
|
|
(mm-encode-coding-region (point-min) (point-max) cs))
|
|
|
|
(funcall (cdr (assq encoding rfc2047-encoding-function-alist))
|
|
|
|
(point-min) (point-max))
|
|
|
|
(goto-char (point-min))
|
|
|
|
(while (not (eobp))
|
|
|
|
(unless first
|
|
|
|
(insert ? ))
|
|
|
|
(setq first nil)
|
|
|
|
(insert start)
|
|
|
|
(end-of-line)
|
|
|
|
(insert "?=")
|
|
|
|
(forward-line 1))))))
|
2000-09-19 13:40:08 +00:00
|
|
|
|
2004-09-04 13:13:48 +00:00
|
|
|
(defun rfc2047-fold-field ()
|
|
|
|
"Fold the current header field."
|
|
|
|
(save-excursion
|
|
|
|
(save-restriction
|
|
|
|
(rfc2047-narrow-to-field)
|
|
|
|
(rfc2047-fold-region (point-min) (point-max)))))
|
|
|
|
|
2000-09-19 13:40:08 +00:00
|
|
|
(defun rfc2047-fold-region (b e)
|
2001-02-08 19:26:36 +00:00
|
|
|
"Fold long lines in region B to E."
|
2000-09-19 13:40:08 +00:00
|
|
|
(save-restriction
|
|
|
|
(narrow-to-region b e)
|
|
|
|
(goto-char (point-min))
|
2000-11-08 15:45:55 +00:00
|
|
|
(let ((break nil)
|
|
|
|
(qword-break nil)
|
2003-05-07 17:27:31 +00:00
|
|
|
(first t)
|
2000-11-08 15:45:55 +00:00
|
|
|
(bol (save-restriction
|
|
|
|
(widen)
|
2004-09-04 13:13:48 +00:00
|
|
|
(rfc2047-point-at-bol))))
|
2000-09-19 13:40:08 +00:00
|
|
|
(while (not (eobp))
|
2004-09-04 13:13:48 +00:00
|
|
|
(when (and (or break qword-break)
|
|
|
|
(> (- (point) bol) 76))
|
2000-11-08 15:45:55 +00:00
|
|
|
(goto-char (or break qword-break))
|
|
|
|
(setq break nil
|
|
|
|
qword-break nil)
|
2003-05-07 17:27:31 +00:00
|
|
|
(if (looking-at "[ \t]")
|
2002-10-18 10:52:56 +00:00
|
|
|
(insert ?\n)
|
2001-01-21 05:33:42 +00:00
|
|
|
(insert "\n "))
|
2000-11-08 15:45:55 +00:00
|
|
|
(setq bol (1- (point)))
|
|
|
|
;; Don't break before the first non-LWSP characters.
|
|
|
|
(skip-chars-forward " \t")
|
2004-09-04 13:13:48 +00:00
|
|
|
(unless (eobp)
|
|
|
|
(forward-char 1)))
|
2000-09-19 13:40:08 +00:00
|
|
|
(cond
|
2000-11-08 15:45:55 +00:00
|
|
|
((eq (char-after) ?\n)
|
|
|
|
(forward-char 1)
|
|
|
|
(setq bol (point)
|
|
|
|
break nil
|
|
|
|
qword-break nil)
|
|
|
|
(skip-chars-forward " \t")
|
|
|
|
(unless (or (eobp) (eq (char-after) ?\n))
|
|
|
|
(forward-char 1)))
|
|
|
|
((eq (char-after) ?\r)
|
|
|
|
(forward-char 1))
|
2000-09-19 13:40:08 +00:00
|
|
|
((memq (char-after) '(? ?\t))
|
2000-11-08 15:45:55 +00:00
|
|
|
(skip-chars-forward " \t")
|
2003-05-07 17:27:31 +00:00
|
|
|
(if first
|
|
|
|
;; Don't break just after the header name.
|
|
|
|
(setq first nil)
|
|
|
|
(setq break (1- (point)))))
|
2000-11-08 15:45:55 +00:00
|
|
|
((not break)
|
|
|
|
(if (not (looking-at "=\\?[^=]"))
|
|
|
|
(if (eq (char-after) ?=)
|
|
|
|
(forward-char 1)
|
|
|
|
(skip-chars-forward "^ \t\n\r="))
|
2004-09-04 13:13:48 +00:00
|
|
|
;; Don't break at the start of the field.
|
|
|
|
(unless (= (point) b)
|
|
|
|
(setq qword-break (point)))
|
2000-11-08 15:45:55 +00:00
|
|
|
(skip-chars-forward "^ \t\n\r")))
|
|
|
|
(t
|
|
|
|
(skip-chars-forward "^ \t\n\r"))))
|
2004-09-04 13:13:48 +00:00
|
|
|
(when (and (or break qword-break)
|
|
|
|
(> (- (point) bol) 76))
|
2000-11-08 15:45:55 +00:00
|
|
|
(goto-char (or break qword-break))
|
|
|
|
(setq break nil
|
|
|
|
qword-break nil)
|
2003-05-07 17:27:31 +00:00
|
|
|
(if (looking-at "[ \t]")
|
2002-10-18 10:52:56 +00:00
|
|
|
(insert ?\n)
|
2001-01-21 05:33:42 +00:00
|
|
|
(insert "\n "))
|
2000-11-08 15:45:55 +00:00
|
|
|
(setq bol (1- (point)))
|
|
|
|
;; Don't break before the first non-LWSP characters.
|
|
|
|
(skip-chars-forward " \t")
|
2004-09-04 13:13:48 +00:00
|
|
|
(unless (eobp)
|
|
|
|
(forward-char 1))))))
|
|
|
|
|
|
|
|
(defun rfc2047-unfold-field ()
|
|
|
|
"Fold the current line."
|
|
|
|
(save-excursion
|
|
|
|
(save-restriction
|
|
|
|
(rfc2047-narrow-to-field)
|
|
|
|
(rfc2047-unfold-region (point-min) (point-max)))))
|
2000-11-08 15:45:55 +00:00
|
|
|
|
|
|
|
(defun rfc2047-unfold-region (b e)
|
2001-02-08 19:26:36 +00:00
|
|
|
"Unfold lines in region B to E."
|
2000-11-08 15:45:55 +00:00
|
|
|
(save-restriction
|
|
|
|
(narrow-to-region b e)
|
|
|
|
(goto-char (point-min))
|
|
|
|
(let ((bol (save-restriction
|
|
|
|
(widen)
|
2004-09-04 13:13:48 +00:00
|
|
|
(rfc2047-point-at-bol)))
|
|
|
|
(eol (rfc2047-point-at-eol)))
|
2000-11-08 15:45:55 +00:00
|
|
|
(forward-line 1)
|
|
|
|
(while (not (eobp))
|
2003-05-07 17:27:31 +00:00
|
|
|
(if (and (looking-at "[ \t]")
|
2004-09-04 13:13:48 +00:00
|
|
|
(< (- (rfc2047-point-at-eol) bol) 76))
|
2003-05-07 17:27:31 +00:00
|
|
|
(delete-region eol (progn
|
|
|
|
(goto-char eol)
|
|
|
|
(skip-chars-forward "\r\n")
|
|
|
|
(point)))
|
2004-09-04 13:13:48 +00:00
|
|
|
(setq bol (rfc2047-point-at-bol)))
|
|
|
|
(setq eol (rfc2047-point-at-eol))
|
2000-11-08 15:45:55 +00:00
|
|
|
(forward-line 1)))))
|
2000-09-19 13:40:08 +00:00
|
|
|
|
|
|
|
(defun rfc2047-b-encode-region (b e)
|
2000-11-08 15:45:55 +00:00
|
|
|
"Base64-encode the header contained in region B to E."
|
2000-09-19 13:40:08 +00:00
|
|
|
(save-restriction
|
|
|
|
(narrow-to-region (goto-char b) e)
|
|
|
|
(while (not (eobp))
|
|
|
|
(base64-encode-region (point) (progn (end-of-line) (point)) t)
|
|
|
|
(if (and (bolp) (eolp))
|
|
|
|
(delete-backward-char 1))
|
|
|
|
(forward-line))))
|
|
|
|
|
|
|
|
(defun rfc2047-q-encode-region (b e)
|
2000-11-08 15:45:55 +00:00
|
|
|
"Quoted-printable-encode the header in region B to E."
|
2000-09-19 13:40:08 +00:00
|
|
|
(save-excursion
|
|
|
|
(save-restriction
|
|
|
|
(narrow-to-region (goto-char b) e)
|
2004-09-04 13:13:48 +00:00
|
|
|
(let ((bol (save-restriction
|
2000-11-08 15:45:55 +00:00
|
|
|
(widen)
|
2004-09-04 13:13:48 +00:00
|
|
|
(rfc2047-point-at-bol))))
|
|
|
|
(quoted-printable-encode-region
|
|
|
|
b e nil
|
|
|
|
;; = (\075), _ (\137), ? (\077) are used in the encoded word.
|
|
|
|
;; Avoid using 8bit characters.
|
|
|
|
;; This list excludes `especials' (see the RFC2047 syntax),
|
|
|
|
;; meaning that some characters in non-structured fields will
|
|
|
|
;; get encoded when they con't need to be. The following is
|
|
|
|
;; what it used to be.
|
|
|
|
;;; ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?"
|
|
|
|
;;; "\010\012\014\040-\074\076\100-\136\140-\177")
|
|
|
|
"-\b\n\f !#-'*+0-9A-Z\\^`-~\d")
|
|
|
|
(subst-char-in-region (point-min) (point-max) ? ?_)
|
2000-11-08 15:45:55 +00:00
|
|
|
;; The size of QP encapsulation is about 20, so set limit to
|
|
|
|
;; 56=76-20.
|
|
|
|
(unless (< (- (point-max) (point-min)) 56)
|
|
|
|
;; Don't break if it could fit in one line.
|
|
|
|
;; Let rfc2047-encode-region break it later.
|
|
|
|
(goto-char (1+ (point-min)))
|
|
|
|
(while (and (not (bobp)) (not (eobp)))
|
|
|
|
(goto-char (min (point-max) (+ 56 bol)))
|
|
|
|
(search-backward "=" (- (point) 2) t)
|
|
|
|
(unless (or (bobp) (eobp))
|
2004-09-04 13:13:48 +00:00
|
|
|
(insert ?\n)
|
2000-11-08 15:45:55 +00:00
|
|
|
(setq bol (point)))))))))
|
2000-09-19 13:40:08 +00:00
|
|
|
|
|
|
|
;;;
|
|
|
|
;;; Functions for decoding RFC2047 messages
|
|
|
|
;;;
|
|
|
|
|
2004-09-04 13:13:48 +00:00
|
|
|
(eval-and-compile
|
|
|
|
(defconst rfc2047-encoded-word-regexp
|
|
|
|
"=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\
|
|
|
|
\\?\\([!->@-~ +]*\\)\\?="))
|
|
|
|
|
|
|
|
;; Fixme: This should decode in place, not cons intermediate strings.
|
|
|
|
;; Also check whether it needs to worry about delimiting fields like
|
|
|
|
;; encoding.
|
|
|
|
|
|
|
|
;; In fact it's reported that (invalid) encoding of mailboxes in
|
|
|
|
;; addr-specs is in use, so delimiting fields might help. Probably
|
|
|
|
;; not decoding a word which isn't properly delimited is good enough
|
|
|
|
;; and worthwhile (is it more correct or not?), e.g. something like
|
|
|
|
;; `=?iso-8859-1?q?foo?=@'.
|
2000-09-19 13:40:08 +00:00
|
|
|
|
|
|
|
(defun rfc2047-decode-region (start end)
|
|
|
|
"Decode MIME-encoded words in region between START and END."
|
|
|
|
(interactive "r")
|
|
|
|
(let ((case-fold-search t)
|
|
|
|
b e)
|
2002-10-18 14:15:44 +00:00
|
|
|
(save-excursion
|
|
|
|
(save-restriction
|
|
|
|
(narrow-to-region start end)
|
|
|
|
(goto-char (point-min))
|
|
|
|
;; Remove whitespace between encoded words.
|
|
|
|
(while (re-search-forward
|
2004-09-04 13:13:48 +00:00
|
|
|
(eval-when-compile
|
|
|
|
(concat "\\(" rfc2047-encoded-word-regexp "\\)"
|
|
|
|
"\\(\n?[ \t]\\)+"
|
|
|
|
"\\(" rfc2047-encoded-word-regexp "\\)"))
|
2002-10-18 14:15:44 +00:00
|
|
|
nil t)
|
|
|
|
(delete-region (goto-char (match-end 1)) (match-beginning 6)))
|
|
|
|
;; Decode the encoded words.
|
|
|
|
(setq b (goto-char (point-min)))
|
|
|
|
(while (re-search-forward rfc2047-encoded-word-regexp nil t)
|
|
|
|
(setq e (match-beginning 0))
|
|
|
|
(insert (rfc2047-parse-and-decode
|
|
|
|
(prog1
|
|
|
|
(match-string 0)
|
|
|
|
(delete-region (match-beginning 0) (match-end 0)))))
|
2004-09-04 13:13:48 +00:00
|
|
|
;; Remove newlines between decoded words, though such things
|
|
|
|
;; essentially must not be there.
|
|
|
|
(save-restriction
|
|
|
|
(narrow-to-region e (point))
|
|
|
|
(goto-char e)
|
|
|
|
(while (re-search-forward "[\n\r]+" nil t)
|
|
|
|
(replace-match " "))
|
|
|
|
(goto-char (point-max)))
|
2002-10-18 14:15:44 +00:00
|
|
|
(when (and (mm-multibyte-p)
|
|
|
|
mail-parse-charset
|
2004-09-04 13:13:48 +00:00
|
|
|
(not (eq mail-parse-charset 'us-ascii))
|
2002-10-18 14:15:44 +00:00
|
|
|
(not (eq mail-parse-charset 'gnus-decoded)))
|
|
|
|
(mm-decode-coding-region b e mail-parse-charset))
|
|
|
|
(setq b (point)))
|
|
|
|
(when (and (mm-multibyte-p)
|
|
|
|
mail-parse-charset
|
|
|
|
(not (eq mail-parse-charset 'us-ascii))
|
|
|
|
(not (eq mail-parse-charset 'gnus-decoded)))
|
2004-09-04 13:13:48 +00:00
|
|
|
(mm-decode-coding-region b (point-max) mail-parse-charset))))))
|
2000-09-19 13:40:08 +00:00
|
|
|
|
|
|
|
(defun rfc2047-decode-string (string)
|
|
|
|
"Decode the quoted-printable-encoded STRING and return the results."
|
|
|
|
(let ((m (mm-multibyte-p)))
|
2004-09-04 13:13:48 +00:00
|
|
|
(if (string-match "=\\?" string)
|
|
|
|
(with-temp-buffer
|
|
|
|
;; Fixme: This logic is wrong, but seems to be required by
|
|
|
|
;; Gnus summary buffer generation. The value of `m' depends
|
|
|
|
;; on the current buffer, not global multibyteness or that
|
|
|
|
;; of the string. Also the string returned should always be
|
|
|
|
;; multibyte in a multibyte session, i.e. the buffer should
|
|
|
|
;; be multibyte before `buffer-string' is called.
|
|
|
|
(when m
|
|
|
|
(mm-enable-multibyte))
|
|
|
|
(insert string)
|
|
|
|
(inline
|
|
|
|
(rfc2047-decode-region (point-min) (point-max)))
|
|
|
|
(buffer-string))
|
|
|
|
;; Fixme: As above, `m' here is inappropriate.
|
|
|
|
(if (and m
|
|
|
|
mail-parse-charset
|
|
|
|
(not (eq mail-parse-charset 'us-ascii))
|
|
|
|
(not (eq mail-parse-charset 'gnus-decoded)))
|
|
|
|
(mm-decode-coding-string string mail-parse-charset)
|
|
|
|
(mm-string-as-multibyte string)))))
|
2000-09-19 13:40:08 +00:00
|
|
|
|
2002-10-18 14:15:44 +00:00
|
|
|
(defun rfc2047-parse-and-decode (word)
|
2000-09-19 13:40:08 +00:00
|
|
|
"Decode WORD and return it if it is an encoded word.
|
2004-09-04 13:13:48 +00:00
|
|
|
Return WORD if it is not not an encoded word or if the charset isn't
|
|
|
|
decodable."
|
2002-10-18 14:15:44 +00:00
|
|
|
(if (not (string-match rfc2047-encoded-word-regexp word))
|
|
|
|
word
|
|
|
|
(or
|
|
|
|
(condition-case nil
|
|
|
|
(rfc2047-decode
|
|
|
|
(match-string 1 word)
|
|
|
|
(upcase (match-string 2 word))
|
|
|
|
(match-string 3 word))
|
|
|
|
(error word))
|
2004-09-04 13:13:48 +00:00
|
|
|
word))) ; un-decodable
|
|
|
|
|
|
|
|
(defun rfc2047-pad-base64 (string)
|
|
|
|
"Pad STRING to quartets."
|
|
|
|
;; Be more liberal to accept buggy base64 strings. If
|
|
|
|
;; base64-decode-string accepts buggy strings, this function could
|
|
|
|
;; be aliased to identity.
|
2004-09-27 07:44:44 +00:00
|
|
|
(if (= 0 (mod (length string) 4))
|
|
|
|
string
|
|
|
|
(when (string-match "=+$" string)
|
|
|
|
(setq string (substring string 0 (match-beginning 0))))
|
|
|
|
(case (mod (length string) 4)
|
|
|
|
(0 string)
|
|
|
|
(1 string) ;; Error, don't pad it.
|
|
|
|
(2 (concat string "=="))
|
|
|
|
(3 (concat string "=")))))
|
2002-10-18 14:15:44 +00:00
|
|
|
|
|
|
|
(defun rfc2047-decode (charset encoding string)
|
|
|
|
"Decode STRING from the given MIME CHARSET in the given ENCODING.
|
2000-09-19 13:40:08 +00:00
|
|
|
Valid ENCODINGs are \"B\" and \"Q\".
|
2000-11-08 15:45:55 +00:00
|
|
|
If your Emacs implementation can't decode CHARSET, return nil."
|
2000-09-19 13:40:08 +00:00
|
|
|
(if (stringp charset)
|
|
|
|
(setq charset (intern (downcase charset))))
|
2000-11-08 15:45:55 +00:00
|
|
|
(if (or (not charset)
|
2000-09-19 13:40:08 +00:00
|
|
|
(eq 'gnus-all mail-parse-ignored-charsets)
|
|
|
|
(memq 'gnus-all mail-parse-ignored-charsets)
|
|
|
|
(memq charset mail-parse-ignored-charsets))
|
|
|
|
(setq charset mail-parse-charset))
|
|
|
|
(let ((cs (mm-charset-to-coding-system charset)))
|
2000-11-08 15:45:55 +00:00
|
|
|
(if (and (not cs) charset
|
2000-09-19 13:40:08 +00:00
|
|
|
(listp mail-parse-ignored-charsets)
|
|
|
|
(memq 'gnus-unknown mail-parse-ignored-charsets))
|
|
|
|
(setq cs (mm-charset-to-coding-system mail-parse-charset)))
|
|
|
|
(when cs
|
|
|
|
(when (and (eq cs 'ascii)
|
|
|
|
mail-parse-charset)
|
|
|
|
(setq cs mail-parse-charset))
|
2004-09-04 13:13:48 +00:00
|
|
|
(mm-decode-coding-string
|
|
|
|
(cond
|
|
|
|
((equal "B" encoding)
|
|
|
|
(base64-decode-string
|
|
|
|
(rfc2047-pad-base64 string)))
|
|
|
|
((equal "Q" encoding)
|
|
|
|
(quoted-printable-decode-string
|
|
|
|
(mm-replace-chars-in-string string ?_ ? )))
|
|
|
|
(t (error "Invalid encoding: %s" encoding)))
|
|
|
|
cs))))
|
2000-09-19 13:40:08 +00:00
|
|
|
|
|
|
|
(provide 'rfc2047)
|
|
|
|
|
2003-09-01 15:45:59 +00:00
|
|
|
;;; arch-tag: a07fe3d4-22b5-4c4a-bd89-b1f82d5d36f6
|
2000-09-19 13:40:08 +00:00
|
|
|
;;; rfc2047.el ends here
|