code.delx.au - gnu-emacs/blob - lisp/international/utf-7.el

   1 ;;; utf-7.el --- utf-7 coding system
   2
   3 ;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Author: Dave Love <fx@gnu.org>
   7 ;; Keywords: i18n, mail
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; Defines a coding system for UTF-7, defined in RFC 2152.  Non-ASCII
  27 ;; segments are encoded as base64-encoded big endian UTF-16.  Also
  28 ;; defines a variation required for IMAP (RFC 2060).
  29
  30 ;; The encoding and decoding was originally taken from Jon K Hellan's
  31 ;; implementation in Gnus, but has been substantially re-done.
  32
  33 ;; This probably needs more attention.  In particular, it's not
  34 ;; completely consistent with iconv's behavior.  It's arguable
  35 ;; whether the IMAP version should be a coding system since it's
  36 ;; apparently only used for IMAP mailbox names, so it's commented out.
  37
  38 ;;; Code:
  39
  40 (defun utf-7-decode (len imap)
  41   "Decode LEN bytes of UTF-7 at point.
  42 IMAP non-nil means use the IMAP version."
  43   (save-excursion
  44     (save-restriction
  45       (narrow-to-region (point) (+ (point) len))
  46       (let ((not-esc (if imap "^&" "^+"))
  47             (skip-chars (if imap "A-Za-z0-9+," "A-Za-z0-9+/")))
  48         (while (not (eobp))
  49           (skip-chars-forward not-esc)
  50           (unless (eobp)
  51             (forward-char)
  52             (let ((p (point))
  53                   (run-length (skip-chars-forward skip-chars)))
  54               (if (eq ?- (char-after))
  55                   (delete-char 1))
  56               (unless (= run-length 0)  ; encoded lone esc-char
  57                 (let ((pl (mod (- run-length) 4)))
  58                   (insert-char ?= pl)
  59                   (if imap
  60                       (subst-char-in-region p (point) ?, ?/))
  61                   (base64-decode-region p (point)))
  62                 (decode-coding-region p (point) 'utf-16be)
  63                 (save-excursion
  64                   (goto-char p)
  65                   (delete-backward-char 1)))))))
  66       (- (point-max) (point-min)))))
  67
  68 ;;;###autoload
  69 (defun utf-7-post-read-conversion (len)
  70   (utf-7-decode len nil))
  71
  72 ;;;###autoload
  73 (defun utf-7-imap-post-read-conversion (len)
  74   (utf-7-decode len t))
  75
  76 (defun utf-7-encode (from to imap)
  77   "Encode bytes between FROM and TO to UTF-7.
  78 ESC and SKIP-CHARS are adjusted for the normal and IMAP versions."
  79   (let* ((old-buf (current-buffer))
  80          (esc (if imap ?& ?+))
  81          ;; These are characters which can be encoded asis.
  82          (skip-chars (if imap
  83                          "\t\n\r\x20-\x25\x27-\x7e" ; rfc2060
  84                        ;; This includes the rfc2152 optional set.
  85                        ;; Perhaps it shouldn't (like iconv).
  86                        "\t\n\r -*,-[]-}"))
  87          (not-skip-chars (format "^%s%c" skip-chars esc)))
  88     (set-buffer (generate-new-buffer " *temp*"))
  89     (if (stringp from)
  90         (insert from)
  91       (insert-buffer-substring old-buf from to))
  92     (goto-char (point-min))
  93     (while (not (eobp))
  94       (skip-chars-forward skip-chars)
  95       (if (eq esc (char-after))
  96           (progn (forward-char)
  97                  (insert ?-))
  98         (unless (eobp)
  99           (insert esc)
 100           (let ((p (point)))
 101             (skip-chars-forward not-skip-chars)
 102             (save-restriction
 103               ;; encode-coding-region doesn't preserve point
 104               (narrow-to-region p (point))
 105               (encode-coding-region p (point-max) 'utf-16be)
 106               (base64-encode-region p (point-max))
 107               (if imap
 108                   (subst-char-in-region p (point-max) ?/ ?,))
 109               (goto-char p)
 110               ;; As I read the RFC, this isn't correct, but it's
 111               ;; consistent with iconv, at least regarding `='.
 112               (skip-chars-forward "^= \t\n")
 113               (delete-region (point) (point-max))))
 114           ;; RFC2060 stipulates that all names MUST end in US-ASCII (i.e.
 115           ;; a name that ends with a Unicode octet MUST end with a "-").
 116           (if (or imap (not (eobp)))
 117             (insert ?-)))))
 118     nil))
 119
 120 ;;;###autoload
 121 (defun utf-7-pre-write-conversion (from to)
 122   (utf-7-encode from to nil))
 123
 124 ;;;###autoload
 125 (defun utf-7-imap-pre-write-conversion (from to)
 126   (utf-7-encode from to t))
 127
 128 (provide 'utf-7)
 129
 130 ;; arch-tag: 975ee403-90a4-4286-97d2-4ed1323f4ef9
 131 ;;; utf-7.el ends here