1 |
;;; utf7.el --- UTF-7 encoding/decoding for Emacs |
;;; utf7.el --- UTF-7 encoding/decoding for Emacs -*-coding: iso-8859-1;-*- |
2 |
;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. |
;; Copyright (C) 1999, 2000, 2003 Free Software Foundation, Inc. |
3 |
|
|
4 |
;; Author: Jon K Hellan <hellan@acm.org> |
;; Author: Jon K Hellan <hellan@acm.org> |
5 |
|
;; Maintainer: bugs@gnus.org |
6 |
;; Keywords: mail |
;; Keywords: mail |
7 |
|
|
8 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
23 |
;; Boston, MA 02111-1307, USA. |
;; Boston, MA 02111-1307, USA. |
24 |
|
|
25 |
;;; Commentary: |
;;; Commentary: |
26 |
;;; UTF-7 - A Mail-Safe Transformation Format of Unicode - RFC 2152 |
|
27 |
;;; This is a transformation format of Unicode that contains only 7-bit |
;; UTF-7 - A Mail-Safe Transformation Format of Unicode - RFC 2152 |
28 |
;;; ASCII octets and is intended to be readable by humans in the limiting |
;; This is a transformation format of Unicode that contains only 7-bit |
29 |
;;; case that the document consists of characters from the US-ASCII |
;; ASCII octets and is intended to be readable by humans in the limiting |
30 |
;;; repertoire. |
;; case that the document consists of characters from the US-ASCII |
31 |
;;; In short, runs of characters outside US-ASCII are encoded as base64 |
;; repertoire. |
32 |
;;; inside delimiters. |
;; In short, runs of characters outside US-ASCII are encoded as base64 |
33 |
;;; A variation of UTF-7 is specified in IMAP 4rev1 (RFC 2060) as the way |
;; inside delimiters. |
34 |
;;; to represent characters outside US-ASCII in mailbox names in IMAP. |
;; A variation of UTF-7 is specified in IMAP 4rev1 (RFC 2060) as the way |
35 |
;;; This library supports both variants, but the IMAP variation was the |
;; to represent characters outside US-ASCII in mailbox names in IMAP. |
36 |
;;; reason I wrote it. |
;; This library supports both variants, but the IMAP variation was the |
37 |
;;; The routines convert UTF-7 -> UTF-16 (16 bit encoding of Unicode) |
;; reason I wrote it. |
38 |
;;; -> current character set, and vice versa. |
;; The routines convert UTF-7 -> UTF-16 (16 bit encoding of Unicode) |
39 |
;;; However, until Emacs supports Unicode, the only Emacs character set |
;; -> current character set, and vice versa. |
40 |
;;; supported here is ISO-8859.1, which can trivially be converted to/from |
;; However, until Emacs supports Unicode, the only Emacs character set |
41 |
;;; Unicode. |
;; supported here is ISO-8859.1, which can trivially be converted to/from |
42 |
;;; When decoding results in a character outside the Emacs character set, |
;; Unicode. |
43 |
;;; an error is thrown. It is up to the application to recover. |
;; When decoding results in a character outside the Emacs character set, |
44 |
|
;; an error is thrown. It is up to the application to recover. |
45 |
|
|
46 |
|
;; UTF-7 should be done by providing a coding system. Mule-UCS does |
47 |
|
;; already, but I don't know if it does the IMAP version and it's not |
48 |
|
;; clear whether that should really be a coding system. The UTF-16 |
49 |
|
;; part of the conversion can be done with coding systems available |
50 |
|
;; with Mule-UCS or some versions of Emacs. Unfortunately these were |
51 |
|
;; done wrongly (regarding handling of byte-order marks and how the |
52 |
|
;; variants were named), so we don't have a consistent name for the |
53 |
|
;; necessary coding system. The code below doesn't seem to DTRT |
54 |
|
;; generally. E.g.: |
55 |
|
;; |
56 |
|
;; (utf7-encode "a+£") |
57 |
|
;; => "a+ACsAow-" |
58 |
|
;; |
59 |
|
;; $ echo "a+£"|iconv -f iso-8859-1 -t utf-7 |
60 |
|
;; a+-+AKM |
61 |
|
;; |
62 |
|
;; -- fx |
63 |
|
|
64 |
|
|
65 |
;;; Code: |
;;; Code: |
66 |
|
|
67 |
(require 'base64) |
(require 'base64) |
68 |
(eval-when-compile (require 'cl)) |
(eval-when-compile (require 'cl)) |
69 |
|
(require 'mm-util) |
70 |
|
|
71 |
(defvar utf7-direct-encoding-chars " -%'-*,-[]-}" |
(defconst utf7-direct-encoding-chars " -%'-*,-[]-}" |
72 |
"Character ranges which do not need escaping in UTF-7.") |
"Character ranges which do not need escaping in UTF-7.") |
73 |
|
|
74 |
(defvar utf7-imap-direct-encoding-chars |
(defconst utf7-imap-direct-encoding-chars |
75 |
(concat utf7-direct-encoding-chars "+\\~") |
(concat utf7-direct-encoding-chars "+\\~") |
76 |
"Character ranges which do not need escaping in the IMAP variant of UTF-7.") |
"Character ranges which do not need escaping in the IMAP variant of UTF-7.") |
77 |
|
|
78 |
|
(defconst utf7-utf-16-coding-system |
79 |
|
(cond ((mm-coding-system-p 'utf-16-be-no-signature) ; Mule-UCS |
80 |
|
'utf-16-be-no-signature) |
81 |
|
((and (mm-coding-system-p 'utf-16-be) ; Emacs 21.4 (?), Emacs 22 |
82 |
|
;; Avoid versions with BOM. |
83 |
|
(= 2 (length (encode-coding-string "a" 'utf-16-be)))) |
84 |
|
'utf-16-be) |
85 |
|
((mm-coding-system-p 'utf-16-be-nosig) ; ? |
86 |
|
'utf-16-be-nosig)) |
87 |
|
"Coding system which encodes big endian UTF-16 without a BOM signature.") |
88 |
|
|
89 |
(defsubst utf7-imap-get-pad-length (len modulus) |
(defsubst utf7-imap-get-pad-length (len modulus) |
90 |
"Return required length of padding for IMAP modified base64 fragment." |
"Return required length of padding for IMAP modified base64 fragment." |
91 |
(mod (- len) modulus)) |
(mod (- len) modulus)) |
97 |
(end (point-max))) |
(end (point-max))) |
98 |
(narrow-to-region start end) |
(narrow-to-region start end) |
99 |
(goto-char start) |
(goto-char start) |
100 |
(let ((esc-char (if for-imap ?& ?+)) |
(let* ((esc-char (if for-imap ?& ?+)) |
101 |
(direct-encoding-chars |
(direct-encoding-chars |
102 |
(if for-imap utf7-imap-direct-encoding-chars |
(if for-imap utf7-imap-direct-encoding-chars |
103 |
utf7-direct-encoding-chars))) |
utf7-direct-encoding-chars)) |
104 |
|
(not-direct-encoding-chars (concat "^" direct-encoding-chars))) |
105 |
(while (not (eobp)) |
(while (not (eobp)) |
106 |
(skip-chars-forward direct-encoding-chars) |
(skip-chars-forward direct-encoding-chars) |
107 |
(unless (eobp) |
(unless (eobp) |
109 |
(let ((p (point)) |
(let ((p (point)) |
110 |
(fc (following-char)) |
(fc (following-char)) |
111 |
(run-length |
(run-length |
112 |
(skip-chars-forward (concat "^" direct-encoding-chars)))) |
(skip-chars-forward not-direct-encoding-chars))) |
113 |
(if (and (= fc esc-char) |
(if (and (= fc esc-char) |
114 |
(= run-length 1)) ; Lone esc-char? |
(= run-length 1)) ; Lone esc-char? |
115 |
(delete-backward-char 1) ; Now there's one too many |
(delete-backward-char 1) ; Now there's one too many |
122 |
(save-restriction |
(save-restriction |
123 |
(narrow-to-region start end) |
(narrow-to-region start end) |
124 |
(funcall (utf7-get-u16char-converter 'to-utf-16)) |
(funcall (utf7-get-u16char-converter 'to-utf-16)) |
125 |
(base64-encode-region start (point-max)) |
(mm-with-unibyte-current-buffer |
126 |
|
(base64-encode-region start (point-max))) |
127 |
(goto-char start) |
(goto-char start) |
128 |
(let ((pm (point-max))) |
(let ((pm (point-max))) |
129 |
(when for-imap |
(when for-imap |
170 |
|
|
171 |
(defun utf7-get-u16char-converter (which-way) |
(defun utf7-get-u16char-converter (which-way) |
172 |
"Return a function to convert between UTF-16 and current character set." |
"Return a function to convert between UTF-16 and current character set." |
173 |
;; Add test to check if we are really Latin-1. |
(if utf7-utf-16-coding-system |
174 |
;; Support other character sets once Emacs groks Unicode. |
(if (eq which-way 'to-utf-16) |
175 |
(if (eq which-way 'to-utf-16) |
(lambda () |
176 |
'utf7-latin1-u16-char-converter |
(encode-coding-region (point-min) (point-max) |
177 |
'utf7-u16-latin1-char-converter)) |
utf7-utf-16-coding-system)) |
178 |
|
(lambda () |
179 |
|
(decode-coding-region (point-min) (point-max) |
180 |
|
utf7-utf-16-coding-system))) |
181 |
|
;; Add test to check if we are really Latin-1. |
182 |
|
(if (eq which-way 'to-utf-16) |
183 |
|
'utf7-latin1-u16-char-converter |
184 |
|
'utf7-u16-latin1-char-converter))) |
185 |
|
|
186 |
(defun utf7-latin1-u16-char-converter () |
(defun utf7-latin1-u16-char-converter () |
187 |
"Convert latin 1 (ISO-8859.1) characters to 16 bit Unicode. |
"Convert latin 1 (ISO-8859.1) characters to 16 bit Unicode. |
188 |
Characters are converted to raw byte pairs in narrowed buffer." |
Characters are converted to raw byte pairs in narrowed buffer." |
189 |
|
(mm-encode-coding-region (point-min) (point-max) 'iso-8859-1) |
190 |
|
(mm-disable-multibyte) |
191 |
(goto-char (point-min)) |
(goto-char (point-min)) |
192 |
(while (not (eobp)) |
(while (not (eobp)) |
193 |
(insert 0) |
(insert 0) |
201 |
(if (= 0 (following-char)) |
(if (= 0 (following-char)) |
202 |
(delete-char 1) |
(delete-char 1) |
203 |
(error "Unable to convert from Unicode")) |
(error "Unable to convert from Unicode")) |
204 |
(forward-char))) |
(forward-char)) |
205 |
|
(mm-decode-coding-region (point-min) (point-max) 'iso-8859-1) |
206 |
|
(mm-enable-multibyte)) |
207 |
|
|
208 |
(defun utf7-encode (string &optional for-imap) |
(defun utf7-encode (string &optional for-imap) |
209 |
"Encode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil." |
"Encode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil." |
210 |
(let ((default-enable-multibyte-characters nil)) |
(let ((default-enable-multibyte-characters t)) |
211 |
(with-temp-buffer |
(with-temp-buffer |
212 |
(insert string) |
(insert string) |
213 |
(utf7-encode-internal for-imap) |
(utf7-encode-internal for-imap) |
219 |
(with-temp-buffer |
(with-temp-buffer |
220 |
(insert string) |
(insert string) |
221 |
(utf7-decode-internal for-imap) |
(utf7-decode-internal for-imap) |
222 |
|
(mm-enable-multibyte) |
223 |
(buffer-string)))) |
(buffer-string)))) |
224 |
|
|
225 |
(provide 'utf7) |
(provide 'utf7) |