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.49 1997/02/13 08:20:53 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 ;;; Code:
  27
  28 (require 'cyrillic)
  29 (require 'emu-xemacs)
  30
  31
  32 ;;; @ coding-system
  33 ;;;
  34
  35 (defconst *noconv* 'no-conversion)
  36 (defconst *ctext*  'ctext)
  37 (defconst *hz*     'hz)
  38 (defconst *big5*   'big5)
  39 (defconst *euc-kr* 'euc-kr)
  40 (defconst *koi8*   'koi8)
  41
  42 (defalias 'set-buffer-file-coding-system 'set-file-coding-system)
  43
  44 (defmacro as-binary-process (&rest body)
  45   `(let (selective-display      ; Disable ^M to nl translation.
  46          (file-coding-system 'no-conversion)
  47          process-input-coding-system
  48          process-output-coding-system)
  49      ,@body))
  50
  51 (defmacro as-binary-input-file (&rest body)
  52   `(let ((file-coding-system-for-read 'no-conversion))
  53      ,@body))
  54
  55 (defmacro as-binary-output-file (&rest body)
  56   `(let ((file-coding-system 'no-conversion))
  57      ,@body))
  58
  59
  60 ;;; @ binary access
  61 ;;;
  62
  63 (defun insert-binary-file-contents-literally
  64   (filename &optional visit beg end replace)
  65   "Like `insert-file-contents-literally', q.v., but don't code conversion.
  66 A buffer may be modified in several ways after reading into the buffer due
  67 to advanced Emacs features, such as file-name-handlers, format decoding,
  68 find-file-hooks, etc.
  69   This function ensures that none of these modifications will take place."
  70   (let ((file-coding-system-for-read 'no-conversion))
  71     (insert-file-contents-literally filename visit beg end replace)
  72     ))
  73
  74
  75 ;;; @ MIME charset
  76 ;;;
  77
  78 (defvar charsets-mime-charset-alist
  79   '(((ascii)                                            . us-ascii)
  80     ((ascii latin-iso8859-1)                            . iso-8859-1)
  81     ((ascii latin-iso8859-2)                            . iso-8859-2)
  82     ((ascii latin-iso8859-3)                            . iso-8859-3)
  83     ((ascii latin-iso8859-4)                            . iso-8859-4)
  84 ;;; ((ascii cyrillic-iso8859-5)                         . iso-8859-5)
  85     ((ascii cyrillic-iso8859-5)                         . koi8-r)
  86     ((ascii arabic-iso8859-6)                           . iso-8859-6)
  87     ((ascii greek-iso8859-7)                            . iso-8859-7)
  88     ((ascii hebrew-iso8859-8)                           . iso-8859-8)
  89     ((ascii latin-iso8859-9)                            . iso-8859-9)
  90     ((ascii latin-jisx0201
  91             japanese-jisx0208-1978 japanese-jisx0208)   . iso-2022-jp)
  92     ((ascii korean-ksc5601)                             . euc-kr)
  93     ((ascii chinese-gb2312)                             . cn-gb-2312)
  94     ((ascii chinese-big5-1 chinese-big5-2)              . cn-big5)
  95     ((ascii latin-iso8859-1 greek-iso8859-7
  96             latin-jisx0201 japanese-jisx0208-1978
  97             chinese-gb2312 japanese-jisx0208
  98             korean-ksc5601 japanese-jisx0212)           . iso-2022-jp-2)
  99     ((ascii latin-iso8859-1 greek-iso8859-7
 100             latin-jisx0201 japanese-jisx0208-1978
 101             chinese-gb2312 japanese-jisx0208
 102             korean-ksc5601 japanese-jisx0212
 103             chinese-cns11643-1 chinese-cns11643-2)      . iso-2022-int-1)
 104     ((ascii latin-iso8859-1 latin-iso8859-2
 105             cyrillic-iso8859-5 greek-iso8859-7
 106             latin-jisx0201 japanese-jisx0208-1978
 107             chinese-gb2312 japanese-jisx0208
 108             korean-ksc5601 japanese-jisx0212
 109             chinese-cns11643-1 chinese-cns11643-2
 110             chinese-cns11643-3 chinese-cns11643-4
 111             chinese-cns11643-5 chinese-cns11643-6
 112             chinese-cns11643-7)                         . iso-2022-int-1)
 113     ))
 114
 115 (defvar default-mime-charset 'x-ctext)
 116
 117 (defvar mime-charset-coding-system-alist
 118   '((iso-8859-1         . ctext)
 119     (x-ctext            . ctext)
 120     (hz-gb-2312         . hz)
 121     (cn-gb-2312         . euc-china)
 122     (gb2312             . euc-china)
 123     (cn-big5            . big5)
 124     (koi8-r             . koi8)
 125     (iso-2022-jp-2      . iso-2022-ss2-7)
 126     ))
 127
 128 (defun mime-charset-to-coding-system (charset)
 129   "Return coding-system by MIME charset. [emu-x20.el]"
 130   (if (stringp charset)
 131       (setq charset (intern (downcase charset)))
 132     )
 133   (or (cdr (assq charset mime-charset-coding-system-alist))
 134       (and (memq charset (coding-system-list)) charset)
 135       ))
 136
 137 (defun detect-mime-charset-region (start end)
 138   "Return MIME charset for region between START and END.
 139 \[emu-x20.el]"
 140   (charsets-to-mime-charset (charsets-in-region start end)))
 141
 142 (defun encode-mime-charset-region (start end charset)
 143   "Encode the text between START and END as MIME CHARSET.
 144 \[emu-x20.el]"
 145   (let ((cs (mime-charset-to-coding-system charset)))
 146     (if cs
 147         (encode-coding-region start end cs)
 148       )))
 149
 150 (defun decode-mime-charset-region (start end charset)
 151   "Decode the text between START and END as MIME CHARSET.
 152 \[emu-x20.el]"
 153   (let ((cs (mime-charset-to-coding-system charset)))
 154     (if cs
 155         (decode-coding-region start end cs)
 156       )))
 157
 158 (defun encode-mime-charset-string (string charset)
 159   "Encode the STRING as MIME CHARSET. [emu-x20.el]"
 160   (let ((cs (mime-charset-to-coding-system charset)))
 161     (if cs
 162         (encode-coding-string string cs)
 163       string)))
 164
 165 (defun decode-mime-charset-string (string charset)
 166   "Decode the STRING as MIME CHARSET. [emu-x20.el]"
 167   (let ((cs (mime-charset-to-coding-system charset)))
 168     (if cs
 169         (decode-coding-string string cs)
 170       string)))
 171
 172
 173 ;;; @ character
 174 ;;;
 175
 176 ;;; @@ Mule emulating aliases
 177 ;;;
 178 ;;; You should not use them.
 179
 180 (defalias 'char-leading-char 'char-charset)
 181
 182 (defun char-category (character)
 183   "Return string of category mnemonics for CHAR in TABLE.
 184 CHAR can be any multilingual character
 185 TABLE defaults to the current buffer's category table.
 186 \[emu-x20.el; Mule emulating function]"
 187   (mapconcat (lambda (chr)
 188                (char-to-string (int-char chr))
 189                )
 190              (char-category-list character)
 191              ""))
 192
 193
 194 ;;; @ string
 195 ;;;
 196
 197 (defun string-to-int-list (str)
 198   (mapcar #'char-int str)
 199   )
 200
 201
 202 ;;; @ end
 203 ;;;
 204
 205 (provide 'emu-x20)
 206
 207 ;;; emu-x20.el ends here