emu-x20.el

   1 ;;; emu-x20.el --- emu API implementation for XEmacs 20 with mule
   2
   3 ;; Copyright (C) 1994,1995,1996,1997 MORIOKA Tomohiko
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Version: $Id: emu-x20.el,v 7.55 1997/05/08 22:21:36 morioka Exp $
   7 ;; Keywords: emulation, compatibility, Mule, XEmacs
   8
   9 ;; This file is part of XEmacs.
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU XEmacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; This module requires XEmacs 20.1 b12 or later with mule.
  29
  30 ;;; Code:
  31
  32 (require 'cyrillic)
  33 (require 'emu-xemacs)
  34
  35
  36 ;;; @ coding-system
  37 ;;;
  38
  39 (defconst *noconv* 'binary)
  40
  41 (defmacro as-binary-process (&rest body)
  42   `(let (selective-display      ; Disable ^M to nl translation.
  43          (coding-system-for-read  'binary)
  44          (coding-system-for-write 'binary))
  45      ,@body))
  46
  47 (defmacro as-binary-input-file (&rest body)
  48   `(let ((coding-system-for-read 'binary))
  49      ,@body))
  50
  51 (defmacro as-binary-output-file (&rest body)
  52   `(let ((coding-system-for-write 'binary))
  53      ,@body))
  54
  55
  56 ;;; @ binary access
  57 ;;;
  58
  59 (defun insert-binary-file-contents-literally
  60   (filename &optional visit beg end replace)
  61   "Like `insert-file-contents-literally', q.v., but don't code conversion.
  62 A buffer may be modified in several ways after reading into the buffer due
  63 to advanced Emacs features, such as file-name-handlers, format decoding,
  64 find-file-hooks, etc.
  65   This function ensures that none of these modifications will take place."
  66   (let ((coding-system-for-read 'binary))
  67     (insert-file-contents-literally filename visit beg end replace)
  68     ))
  69
  70
  71 ;;; @ MIME charset
  72 ;;;
  73
  74 (defvar charsets-mime-charset-alist
  75   '(((ascii)                                            . us-ascii)
  76     ((ascii latin-iso8859-1)                            . iso-8859-1)
  77     ((ascii latin-iso8859-2)                            . iso-8859-2)
  78     ((ascii latin-iso8859-3)                            . iso-8859-3)
  79     ((ascii latin-iso8859-4)                            . iso-8859-4)
  80 ;;; ((ascii cyrillic-iso8859-5)                         . iso-8859-5)
  81     ((ascii cyrillic-iso8859-5)                         . koi8-r)
  82     ((ascii arabic-iso8859-6)                           . iso-8859-6)
  83     ((ascii greek-iso8859-7)                            . iso-8859-7)
  84     ((ascii hebrew-iso8859-8)                           . iso-8859-8)
  85     ((ascii latin-iso8859-9)                            . iso-8859-9)
  86     ((ascii latin-jisx0201
  87             japanese-jisx0208-1978 japanese-jisx0208)   . iso-2022-jp)
  88     ((ascii korean-ksc5601)                             . euc-kr)
  89     ((ascii chinese-gb2312)                             . cn-gb-2312)
  90     ((ascii chinese-big5-1 chinese-big5-2)              . cn-big5)
  91     ((ascii latin-iso8859-1 greek-iso8859-7
  92             latin-jisx0201 japanese-jisx0208-1978
  93             chinese-gb2312 japanese-jisx0208
  94             korean-ksc5601 japanese-jisx0212)           . iso-2022-jp-2)
  95     ((ascii latin-iso8859-1 greek-iso8859-7
  96             latin-jisx0201 japanese-jisx0208-1978
  97             chinese-gb2312 japanese-jisx0208
  98             korean-ksc5601 japanese-jisx0212
  99             chinese-cns11643-1 chinese-cns11643-2)      . iso-2022-int-1)
 100     ((ascii latin-iso8859-1 latin-iso8859-2
 101             cyrillic-iso8859-5 greek-iso8859-7
 102             latin-jisx0201 japanese-jisx0208-1978
 103             chinese-gb2312 japanese-jisx0208
 104             korean-ksc5601 japanese-jisx0212
 105             chinese-cns11643-1 chinese-cns11643-2
 106             chinese-cns11643-3 chinese-cns11643-4
 107             chinese-cns11643-5 chinese-cns11643-6
 108             chinese-cns11643-7)                         . iso-2022-int-1)
 109     ))
 110
 111 (defvar default-mime-charset 'x-ctext)
 112
 113 (defvar mime-charset-coding-system-alist
 114   '((iso-8859-1         . ctext)
 115     (x-ctext            . ctext)
 116     (hz-gb-2312         . hz)
 117     (cn-gb-2312         . euc-china)
 118     (gb2312             . euc-china)
 119     (cn-big5            . big5)
 120     (koi8-r             . koi8)
 121     (iso-2022-jp-2      . iso-2022-ss2-7)
 122     ))
 123
 124 (defun mime-charset-to-coding-system (charset)
 125   "Return coding-system by MIME charset."
 126   (if (stringp charset)
 127       (setq charset (intern (downcase charset)))
 128     )
 129   (or (cdr (assq charset mime-charset-coding-system-alist))
 130       (and (memq charset (coding-system-list)) charset)
 131       ))
 132
 133 (defun detect-mime-charset-region (start end)
 134   "Return MIME charset for region between START and END."
 135   (charsets-to-mime-charset (charsets-in-region start end)))
 136
 137 (defun encode-mime-charset-region (start end charset)
 138   "Encode the text between START and END as MIME CHARSET."
 139   (let ((cs (mime-charset-to-coding-system charset)))
 140     (if cs
 141         (encode-coding-region start end cs)
 142       )))
 143
 144 (defun decode-mime-charset-region (start end charset)
 145   "Decode the text between START and END as MIME CHARSET."
 146   (let ((cs (mime-charset-to-coding-system charset)))
 147     (if cs
 148         (decode-coding-region start end cs)
 149       )))
 150
 151 (defun encode-mime-charset-string (string charset)
 152   "Encode the STRING as MIME CHARSET."
 153   (let ((cs (mime-charset-to-coding-system charset)))
 154     (if cs
 155         (encode-coding-string string cs)
 156       string)))
 157
 158 (defun decode-mime-charset-string (string charset)
 159   "Decode the STRING as MIME CHARSET."
 160   (let ((cs (mime-charset-to-coding-system charset)))
 161     (if cs
 162         (decode-coding-string string cs)
 163       string)))
 164
 165
 166 ;;; @ character
 167 ;;;
 168
 169 ;;; @@ Mule emulating aliases
 170 ;;;
 171 ;;; You should not use them.
 172
 173 (defalias 'char-leading-char 'char-charset)
 174
 175 (defun char-category (character)
 176   "Return string of category mnemonics for CHAR in TABLE.
 177 CHAR can be any multilingual character
 178 TABLE defaults to the current buffer's category table."
 179   (mapconcat (lambda (chr)
 180                (char-to-string (int-char chr))
 181                )
 182              (char-category-list character)
 183              ""))
 184
 185
 186 ;;; @ string
 187 ;;;
 188
 189 (defun string-to-int-list (str)
 190   (mapcar #'char-int str)
 191   )
 192
 193
 194 ;;; @ end
 195 ;;;
 196
 197 (provide 'emu-x20)
 198
 199 ;;; emu-x20.el ends here