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