code.delx.au - gnu-emacs/blob - lisp/gnus/utf7.el

   1 ;;; utf7.el --- UTF-7 encoding/decoding for Emacs
   2 ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
   3
   4 ;; Author: Jon K Hellan <hellan@acm.org>
   5 ;; Keywords: mail
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  21 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25 ;;; UTF-7 - A Mail-Safe Transformation Format of Unicode - RFC 2152
  26 ;;; This is a transformation format of Unicode that contains only 7-bit
  27 ;;; ASCII octets and is intended to be readable by humans in the limiting
  28 ;;; case that the document consists of characters from the US-ASCII
  29 ;;; repertoire.
  30 ;;; In short, runs of characters outside US-ASCII are encoded as base64
  31 ;;; inside delimiters.
  32 ;;; A variation of UTF-7 is specified in IMAP 4rev1 (RFC 2060) as the way
  33 ;;; to represent characters outside US-ASCII in mailbox names in IMAP.
  34 ;;; This library supports both variants, but the IMAP variation was the
  35 ;;; reason I wrote it.
  36 ;;; The routines convert UTF-7 -> UTF-16 (16 bit encoding of Unicode)
  37 ;;; -> current character set, and vice versa.
  38 ;;; However, until Emacs supports Unicode, the only Emacs character set
  39 ;;; supported here is ISO-8859.1, which can trivially be converted to/from
  40 ;;; Unicode.
  41 ;;; When decoding results in a character outside the Emacs character set,
  42 ;;; an error is thrown.  It is up to the application to recover.
  43
  44 ;;; Code:
  45
  46 (require 'base64)
  47
  48 (defvar utf7-direct-encoding-chars " -%'-*,-[]-}"
  49   "Character ranges which do not need escaping in UTF-7.")
  50
  51 (defvar utf7-imap-direct-encoding-chars
  52   (concat utf7-direct-encoding-chars "+\\~")
  53   "Character ranges which do not need escaping in the IMAP variant of UTF-7.")
  54
  55 (defsubst utf7-imap-get-pad-length (len modulus)
  56   "Return required length of padding for IMAP modified base64 fragment."
  57   (mod (- len) modulus))
  58
  59 (defun utf7-encode-internal (&optional for-imap)
  60   "Encode text in (temporary) buffer as UTF-7.
  61 Use IMAP modification if FOR-IMAP is non-nil."
  62   (let ((start (point-min))
  63         (end (point-max)))
  64     (narrow-to-region start end)
  65     (goto-char start)
  66     (let ((esc-char (if for-imap ?& ?+))
  67           (direct-encoding-chars
  68            (if for-imap utf7-imap-direct-encoding-chars
  69              utf7-direct-encoding-chars)))
  70       (while (not (eobp))
  71         (skip-chars-forward direct-encoding-chars)
  72         (unless (eobp)
  73           (insert esc-char)
  74           (let ((p (point))
  75                 (fc (following-char))
  76                 (run-length
  77                  (skip-chars-forward (concat "^" direct-encoding-chars))))
  78             (if (and (= fc esc-char)
  79                      (= run-length 1))  ; Lone esc-char?
  80                 (delete-backward-char 1) ; Now there's one too many
  81               (utf7-fragment-encode p (point) for-imap))
  82             (insert "-")))))))
  83
  84 (defun utf7-fragment-encode (start end &optional for-imap)
  85   "Encode text from START to END in buffer as UTF-7 escape fragment.
  86 Use IMAP modification if FOR-IMAP is non-nil."
  87   (save-restriction
  88     (narrow-to-region start end)
  89     (funcall (utf7-get-u16char-converter 'to-utf-16))
  90     (base64-encode-region start (point-max))
  91     (goto-char start)
  92     (let ((pm (point-max)))
  93       (when for-imap
  94         (while (search-forward "/" nil t)
  95           (replace-match ",")))
  96       (skip-chars-forward "^= \t\n" pm)
  97       (delete-region (point) pm))))
  98
  99 (defun utf7-decode-internal (&optional for-imap)
 100   "Decode UTF-7 text in (temporary) buffer.
 101 Use IMAP modification if FOR-IMAP is non-nil."
 102   (let ((start (point-min))
 103         (end (point-max)))
 104     (goto-char start)
 105     (let* ((esc-pattern (concat "^" (char-to-string (if for-imap ?& ?+))))
 106            (base64-chars (concat "A-Za-z0-9+"
 107                                  (char-to-string (if for-imap ?, ?/)))))
 108       (while (not (eobp))
 109         (skip-chars-forward esc-pattern)
 110         (unless (eobp)
 111           (forward-char)
 112           (let ((p (point))
 113                 (run-length (skip-chars-forward base64-chars)))
 114             (when (and (not (eobp)) (= (following-char) ?-))
 115               (delete-char 1))
 116             (unless (= run-length 0)    ; Encoded lone esc-char?
 117               (save-excursion
 118                 (utf7-fragment-decode p (point) for-imap)
 119                 (goto-char p)
 120                 (delete-backward-char 1)))))))))
 121
 122 (defun utf7-fragment-decode (start end &optional for-imap)
 123   "Decode base64 encoded fragment from START to END of UTF-7 text in buffer.
 124 Use IMAP modification if FOR-IMAP is non-nil."
 125   (save-restriction
 126     (narrow-to-region start end)
 127     (when for-imap
 128       (goto-char start)
 129       (while (search-forward "," nil 'move-to-end) (replace-match "/")))
 130     (let ((pl (utf7-imap-get-pad-length (- end start) 4)))
 131       (insert (make-string pl ?=))
 132       (base64-decode-region start (+ end pl)))
 133     (funcall (utf7-get-u16char-converter 'from-utf-16))))
 134
 135 (defun utf7-get-u16char-converter (which-way)
 136   "Return a function to convert between UTF-16 and current character set."
 137   ;; Add test to check if we are really Latin-1.
 138   ;; Support other character sets once Emacs groks Unicode.
 139   (if (eq which-way 'to-utf-16)
 140       'utf7-latin1-u16-char-converter
 141     'utf7-u16-latin1-char-converter))
 142
 143 (defun utf7-latin1-u16-char-converter ()
 144   "Convert latin 1 (ISO-8859.1) characters to 16 bit Unicode.
 145 Characters are converted to raw byte pairs in narrowed buffer."
 146   (goto-char (point-min))
 147   (while (not (eobp))
 148     (insert 0)
 149     (forward-char)))
 150
 151 (defun utf7-u16-latin1-char-converter ()
 152   "Convert 16 bit Unicode characters to latin 1 (ISO-8859.1).
 153 Characters are in raw byte pairs in narrowed buffer."
 154   (goto-char (point-min))
 155   (while (not (eobp))
 156     (if (= 0 (following-char))
 157         (delete-char 1)
 158         (error "Unable to convert from Unicode"))
 159     (forward-char)))
 160
 161 (defun utf7-encode (string &optional for-imap)
 162   "Encode UTF-7 STRING.  Use IMAP modification if FOR-IMAP is non-nil."
 163   (let ((default-enable-multibyte-characters nil))
 164     (with-temp-buffer
 165       (insert string)
 166       (utf7-encode-internal for-imap)
 167       (buffer-string))))
 168
 169 (defun utf7-decode (string &optional for-imap)
 170   "Decode UTF-7 STRING.  Use IMAP modification if FOR-IMAP is non-nil."
 171   (let ((default-enable-multibyte-characters nil))
 172     (with-temp-buffer
 173       (insert string)
 174       (utf7-decode-internal for-imap)
 175       (buffer-string))))
 176
 177 (provide 'utf7)
 178
 179 ;;; utf7.el ends here