/[emacs]/emacs/lisp/gnus/utf7.el
ViewVC logotype

Diff of /emacs/lisp/gnus/utf7.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2.18.1 by miles, Tue Oct 14 23:34:51 2003 UTC revision 1.2.18.2 by miles, Thu Sep 16 00:12:16 2004 UTC
# Line 1  Line 1 
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.
# Line 22  Line 23 
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))
# Line 64  Use IMAP modification if FOR-IMAP is non Line 97  Use IMAP modification if FOR-IMAP is non
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)
# Line 75  Use IMAP modification if FOR-IMAP is non Line 109  Use IMAP modification if FOR-IMAP is non
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
# Line 88  Use IMAP modification if FOR-IMAP is non Line 122  Use IMAP modification if FOR-IMAP is non
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
# Line 135  Use IMAP modification if FOR-IMAP is non Line 170  Use IMAP modification if FOR-IMAP is non
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)
# Line 157  Characters are in raw byte pairs in narr Line 201  Characters are in raw byte pairs in narr
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)
# Line 173  Characters are in raw byte pairs in narr Line 219  Characters are in raw byte pairs in narr
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)

Legend:
Removed from v.1.2.18.1  
changed lines
  Added in v.1.2.18.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26