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 (eval-when-compile (require 'cl))
  48
  49 (defvar utf7-direct-encoding-chars " -%'-*,-[]-}"
  50   "Character ranges which do not need escaping in UTF-7.")
  51
  52 (defvar utf7-imap-direct-encoding-chars
  53   (concat utf7-direct-encoding-chars "+\\~")
  54   "Character ranges which do not need escaping in the IMAP variant of UTF-7.")
  55
  56 (defsubst utf7-imap-get-pad-length (len modulus)
  57   "Return required length of padding for IMAP modified base64 fragment."
  58   (mod (- len) modulus))
  59
  60 (defun utf7-encode-internal (&optional for-imap)
  61   "Encode text in (temporary) buffer as UTF-7.
  62 Use IMAP modification if FOR-IMAP is non-nil."
  63   (let ((start (point-min))
  64         (end (point-max)))
  65     (narrow-to-region start end)
  66     (goto-char start)
  67     (let ((esc-char (if for-imap ?& ?+))
  68           (direct-encoding-chars
  69            (if for-imap utf7-imap-direct-encoding-chars
  70              utf7-direct-encoding-chars)))
  71       (while (not (eobp))
  72         (skip-chars-forward direct-encoding-chars)
  73         (unless (eobp)
  74           (insert esc-char)
  75           (let ((p (point))
  76                 (fc (following-char))
  77                 (run-length
  78                  (skip-chars-forward (concat "^" direct-encoding-chars))))
  79             (if (and (= fc esc-char)
  80                      (= run-length 1))  ; Lone esc-char?
  81                 (delete-backward-char 1) ; Now there's one too many
  82               (utf7-fragment-encode p (point) for-imap))
  83             (insert "-")))))))
  84
  85 (defun utf7-fragment-encode (start end &optional for-imap)
  86   "Encode text from START to END in buffer as UTF-7 escape fragment.
  87 Use IMAP modification if FOR-IMAP is non-nil."
  88   (save-restriction
  89     (narrow-to-region start end)
  90     (funcall (utf7-get-u16char-converter 'to-utf-16))
  91     (base64-encode-region start (point-max))
  92     (goto-char start)
  93     (let ((pm (point-max)))
  94       (when for-imap
  95         (while (search-forward "/" nil t)
  96           (replace-match ",")))
  97       (skip-chars-forward "^= \t\n" pm)
  98       (delete-region (point) pm))))
  99
 100 (defun utf7-decode-internal (&optional for-imap)
 101   "Decode UTF-7 text in (temporary) buffer.
 102 Use IMAP modification if FOR-IMAP is non-nil."
 103   (let ((start (point-min))
 104         (end (point-max)))
 105     (goto-char start)
 106     (let* ((esc-pattern (concat "^" (char-to-string (if for-imap ?& ?+))))
 107            (base64-chars (concat "A-Za-z0-9+"
 108                                  (char-to-string (if for-imap ?, ?/)))))
 109       (while (not (eobp))
 110         (skip-chars-forward esc-pattern)
 111         (unless (eobp)
 112           (forward-char)
 113           (let ((p (point))
 114                 (run-length (skip-chars-forward base64-chars)))
 115             (when (and (not (eobp)) (= (following-char) ?-))
 116               (delete-char 1))
 117             (unless (= run-length 0)    ; Encoded lone esc-char?
 118               (save-excursion
 119                 (utf7-fragment-decode p (point) for-imap)
 120                 (goto-char p)
 121                 (delete-backward-char 1)))))))))
 122
 123 (defun utf7-fragment-decode (start end &optional for-imap)
 124   "Decode base64 encoded fragment from START to END of UTF-7 text in buffer.
 125 Use IMAP modification if FOR-IMAP is non-nil."
 126   (save-restriction
 127     (narrow-to-region start end)
 128     (when for-imap
 129       (goto-char start)
 130       (while (search-forward "," nil 'move-to-end) (replace-match "/")))
 131     (let ((pl (utf7-imap-get-pad-length (- end start) 4)))
 132       (insert (make-string pl ?=))
 133       (base64-decode-region start (+ end pl)))
 134     (funcall (utf7-get-u16char-converter 'from-utf-16))))
 135
 136 (defun utf7-get-u16char-converter (which-way)
 137   "Return a function to convert between UTF-16 and current character set."
 138   ;; Add test to check if we are really Latin-1.
 139   ;; Support other character sets once Emacs groks Unicode.
 140   (if (eq which-way 'to-utf-16)
 141       'utf7-latin1-u16-char-converter
 142     'utf7-u16-latin1-char-converter))
 143
 144 (defun utf7-latin1-u16-char-converter ()
 145   "Convert latin 1 (ISO-8859.1) characters to 16 bit Unicode.
 146 Characters are converted to raw byte pairs in narrowed buffer."
 147   (goto-char (point-min))
 148   (while (not (eobp))
 149     (insert 0)
 150     (forward-char)))
 151
 152 (defun utf7-u16-latin1-char-converter ()
 153   "Convert 16 bit Unicode characters to latin 1 (ISO-8859.1).
 154 Characters are in raw byte pairs in narrowed buffer."
 155   (goto-char (point-min))
 156   (while (not (eobp))
 157     (if (= 0 (following-char))
 158         (delete-char 1)
 159         (error "Unable to convert from Unicode"))
 160     (forward-char)))
 161
 162 (defun utf7-encode (string &optional for-imap)
 163   "Encode UTF-7 STRING.  Use IMAP modification if FOR-IMAP is non-nil."
 164   (let ((default-enable-multibyte-characters nil))
 165     (with-temp-buffer
 166       (insert string)
 167       (utf7-encode-internal for-imap)
 168       (buffer-string))))
 169
 170 (defun utf7-decode (string &optional for-imap)
 171   "Decode UTF-7 STRING.  Use IMAP modification if FOR-IMAP is non-nil."
 172   (let ((default-enable-multibyte-characters nil))
 173     (with-temp-buffer
 174       (insert string)
 175       (utf7-decode-internal for-imap)
 176       (buffer-string))))
 177
 178 (provide 'utf7)
 179
 180 ;;; arch-tag: 96078b55-85c7-4161-aed2-932c24b282c7
 181 ;;; utf7.el ends here