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.46 1997/01/29 15:02:16 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 (defvar xemacs-beta-version
  32   (if (string-match "(beta\\([0-9]+\\))" emacs-version)
  33       (string-to-number
  34        (substring emacs-version (match-beginning 1)(match-end 1))
  35        )))
  36
  37
  38 ;;; @ coding-system
  39 ;;;
  40
  41 (defconst *noconv* 'no-conversion)
  42 (defconst *ctext*  'ctext)
  43 (defconst *hz*     'hz)
  44 (defconst *big5*   'big5)
  45 (defconst *euc-kr* 'euc-kr)
  46 (defconst *koi8*   'koi8)
  47
  48 (defalias 'set-buffer-file-coding-system 'set-file-coding-system)
  49
  50 (defmacro as-binary-process (&rest body)
  51   `(let (selective-display      ; Disable ^M to nl translation.
  52          process-input-coding-system
  53          process-output-coding-system)
  54      ,@body))
  55
  56 (defmacro as-binary-input-file (&rest body)
  57   `(let ((file-coding-system-for-read 'no-conversion))
  58      ,@body))
  59
  60 (defmacro as-binary-output-file (&rest body)
  61   `(let ((file-coding-system 'no-conversion))
  62      ,@body))
  63
  64
  65 ;;; @ MIME charset
  66 ;;;
  67
  68 (defvar charsets-mime-charset-alist
  69   '(((ascii)                                            . us-ascii)
  70     ((ascii latin-iso8859-1)                            . iso-8859-1)
  71     ((ascii latin-iso8859-2)                            . iso-8859-2)
  72     ((ascii latin-iso8859-3)                            . iso-8859-3)
  73     ((ascii latin-iso8859-4)                            . iso-8859-4)
  74 ;;; ((ascii cyrillic-iso8859-5)                         . iso-8859-5)
  75     ((ascii cyrillic-iso8859-5)                         . koi8-r)
  76     ((ascii arabic-iso8859-6)                           . iso-8859-6)
  77     ((ascii greek-iso8859-7)                            . iso-8859-7)
  78     ((ascii hebrew-iso8859-8)                           . iso-8859-8)
  79     ((ascii latin-iso8859-9)                            . iso-8859-9)
  80     ((ascii latin-jisx0201
  81             japanese-jisx0208-1978 japanese-jisx0208)   . iso-2022-jp)
  82     ((ascii korean-ksc5601)                             . euc-kr)
  83     ((ascii chinese-gb2312)                             . cn-gb-2312)
  84     ((ascii chinese-big5-1 chinese-big5-2)              . cn-big5)
  85     ((ascii latin-iso8859-1 greek-iso8859-7
  86             latin-jisx0201 japanese-jisx0208-1978
  87             chinese-gb2312 japanese-jisx0208
  88             korean-ksc5601 japanese-jisx0212)           . iso-2022-jp-2)
  89     ((ascii latin-iso8859-1 greek-iso8859-7
  90             latin-jisx0201 japanese-jisx0208-1978
  91             chinese-gb2312 japanese-jisx0208
  92             korean-ksc5601 japanese-jisx0212
  93             chinese-cns11643-1 chinese-cns11643-2)      . iso-2022-int-1)
  94     ((ascii latin-iso8859-1 latin-iso8859-2
  95             cyrillic-iso8859-5 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
 100             chinese-cns11643-3 chinese-cns11643-4
 101             chinese-cns11643-5 chinese-cns11643-6
 102             chinese-cns11643-7)                         . iso-2022-int-1)
 103     ))
 104
 105 (defvar default-mime-charset 'x-ctext)
 106
 107 (defvar mime-charset-coding-system-alist
 108   '((iso-8859-1         . ctext)
 109     (x-ctext            . ctext)
 110     (hz-gb-2312         . hz)
 111     (cn-gb-2312         . euc-china)
 112     (gb2312             . euc-china)
 113     (cn-big5            . big5)
 114     (koi8-r             . koi8)
 115     (iso-2022-jp-2      . iso-2022-ss2-7)
 116     ))
 117
 118 (defun mime-charset-to-coding-system (charset)
 119   "Return coding-system by MIME charset. [emu-x20.el]"
 120   (if (stringp charset)
 121       (setq charset (intern (downcase charset)))
 122     )
 123   (or (cdr (assq charset mime-charset-coding-system-alist))
 124       (and (memq charset (coding-system-list)) charset)
 125       ))
 126
 127 (defun detect-mime-charset-region (start end)
 128   "Return MIME charset for region between START and END.
 129 \[emu-x20.el]"
 130   (charsets-to-mime-charset (charsets-in-region start end)))
 131
 132 (defun encode-mime-charset-region (start end charset)
 133   "Encode the text between START and END as MIME CHARSET.
 134 \[emu-x20.el]"
 135   (let ((cs (mime-charset-to-coding-system charset)))
 136     (if cs
 137         (encode-coding-region start end cs)
 138       )))
 139
 140 (defun decode-mime-charset-region (start end charset)
 141   "Decode the text between START and END as MIME CHARSET.
 142 \[emu-x20.el]"
 143   (let ((cs (mime-charset-to-coding-system charset)))
 144     (if cs
 145         (decode-coding-region start end cs)
 146       )))
 147
 148 (defun encode-mime-charset-string (string charset)
 149   "Encode the STRING as MIME CHARSET. [emu-x20.el]"
 150   (let ((cs (mime-charset-to-coding-system charset)))
 151     (if cs
 152         (encode-coding-string string cs)
 153       string)))
 154
 155 (defun decode-mime-charset-string (string charset)
 156   "Decode the STRING as MIME CHARSET. [emu-x20.el]"
 157   (let ((cs (mime-charset-to-coding-system charset)))
 158     (if cs
 159         (decode-coding-string string cs)
 160       string)))
 161
 162
 163 ;;; @ character
 164 ;;;
 165
 166 ;; (defun char-bytes (chr) 1)
 167
 168 ;; (defun char-length (character)
 169 ;;   "Return number of elements a CHARACTER occupies in a string or buffer.
 170 ;; \[emu-x20.el]"
 171 ;;   1)
 172
 173 ;; (defun char-columns (character)
 174 ;;   "Return number of columns a CHARACTER occupies when displayed.
 175 ;; \[emu-x20.el]"
 176 ;;   (charset-columns (char-charset character))
 177 ;;   )
 178
 179 ;;; @@ Mule emulating aliases
 180 ;;;
 181 ;;; You should not use them.
 182
 183 ;;(defalias 'char-width 'char-columns)
 184
 185 (defalias 'char-leading-char 'char-charset)
 186
 187 (defun char-category (character)
 188   "Return string of category mnemonics for CHAR in TABLE.
 189 CHAR can be any multilingual character
 190 TABLE defaults to the current buffer's category table.
 191 \[emu-x20.el; Mule emulating function]"
 192   (mapconcat (lambda (chr)
 193                (char-to-string (int-char chr))
 194                )
 195              (char-category-list character)
 196              ""))
 197
 198
 199 ;;; @ string
 200 ;;;
 201
 202 ;; (defun string-columns (string)
 203 ;;   "Return number of columns STRING occupies when displayed.
 204 ;; \[emu-x20.el]"
 205 ;;   (let ((col 0)
 206 ;;         (len (length string))
 207 ;;         (i 0))
 208 ;;     (while (< i len)
 209 ;;       (setq col (+ col (char-columns (aref string i))))
 210 ;;       (setq i (1+ i))
 211 ;;       )
 212 ;;     col))
 213
 214 ;;(defalias 'string-width 'string-columns)
 215
 216 (defun string-to-int-list (str)
 217   (mapcar #'char-int str)
 218   )
 219
 220 ;;(defalias 'sref 'aref)
 221
 222 ;; (defun truncate-string (str width &optional start-column)
 223 ;;   "Truncate STR to fit in WIDTH columns.
 224 ;; Optional non-nil arg START-COLUMN specifies the starting column.
 225 ;; \[emu-x20.el; Mule 2.3 emulating function]"
 226 ;;   (or start-column
 227 ;;       (setq start-column 0))
 228 ;;   (substring str start-column width)
 229 ;;   )
 230
 231
 232 ;;; @ end
 233 ;;;
 234
 235 (provide 'emu-x20)
 236
 237 ;;; emu-x20.el ends here