emu-x20.el

   1 ;;;
   2 ;;; emu-x20.el --- Mule 2 emulation module for XEmacs 20 with Mule
   3 ;;;
   4 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
   5 ;;; Copyright (C) 1994 .. 1996 MORIOKA Tomohiko
   6 ;;;
   7 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   8 ;;; Version:
   9 ;;;     $Id: emu-x20.el,v 7.15 1996/06/10 07:59:23 morioka Exp $
  10 ;;; Keywords: emulation, compatibility, Mule, XEmacs
  11 ;;;
  12 ;;; This file is part of tl (Tiny Library).
  13 ;;;
  14 ;;; This program is free software; you can redistribute it and/or
  15 ;;; modify it under the terms of the GNU General Public License as
  16 ;;; published by the Free Software Foundation; either version 2, or
  17 ;;; (at your option) any later version.
  18 ;;;
  19 ;;; This program is distributed in the hope that it will be useful,
  20 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 ;;; General Public License for more details.
  23 ;;;
  24 ;;; You should have received a copy of the GNU General Public License
  25 ;;; along with This program.  If not, write to the Free Software
  26 ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  27 ;;;
  28 ;;; Code:
  29
  30 (require 'emu-xemacs)
  31
  32 (defvar xemacs-beta-version
  33   (if (string-match "(beta\\([0-9]+\\))" emacs-version)
  34       (string-to-number
  35        (substring emacs-version (match-beginning 1)(match-end 1))
  36        )))
  37
  38
  39 ;;; @ character set
  40 ;;;
  41
  42 (mapcar (lambda (charset)
  43           (set
  44            (cond ((eq charset 'japanese-kana)  'charset-jisx0201-kana)
  45                  ((eq charset 'japanese-roman) 'charset-jisx0201-latin)
  46                  ((eq charset 'japanese-old)   'charset-jisx0208-1978)
  47                  ((eq charset 'chinese-gb)     'charset-gb2312)
  48                  ((eq charset 'japanese)       'charset-jisx0208)
  49                  ((eq charset 'koran)          'charset-ksc5601)
  50                  ((eq charset 'japanese-2)     'charset-jisx0212)
  51                  ((eq charset 'chinese-cns-1)  'charset-cns11643-1)
  52                  ((eq charset 'chinese-cns-2)  'charset-cns11643-2)
  53                  ((eq charset 'chinese-cns-3)  'charset-cns11643-3)
  54                  ((eq charset 'chinese-cns-4)  'charset-cns11643-4)
  55                  ((eq charset 'chinese-cns-5)  'charset-cns11643-5)
  56                  ((eq charset 'chinese-cns-6)  'charset-cns11643-6)
  57                  ((eq charset 'chinese-cns-7)  'charset-cns11643-7)
  58                  ((eq charset 'chinese-big5-1) 'charset-big5-1)
  59                  ((eq charset 'chinese-big5-2) 'charset-big5-2)
  60                  (t (intern (concat "charset-" (symbol-name charset))))
  61                  )
  62            charset)
  63           )
  64         (charset-list)
  65         )
  66
  67 (defalias 'charset-description 'charset-doc-string)
  68
  69 (defun find-charset-string (string)
  70   "Return a list of charsets in the STRING except ascii.
  71 \[emu-x20.el; Mule emulating function]"
  72   (delq 'ascii (charsets-in-string string))
  73   )
  74
  75 (defun find-charset-region (start end)
  76   "Return a list of charsets except ascii
  77 in the region between START and END.
  78 \[emu-x20.el; Mule emulating function]"
  79   (delq 'ascii (charsets-in-region start end))
  80   )
  81
  82 ;;; @@ for Mule emulation
  83 ;;;
  84
  85 (defconst lc-ascii  'ascii)
  86 (defconst lc-ltn1   'latin-1)
  87 (defconst lc-ltn2   'latin-2)
  88 (defconst lc-ltn3   'latin-3)
  89 (defconst lc-ltn4   'latin-4)
  90 (defconst lc-crl    'cyrillic)
  91 (defconst lc-arb    'arabic)
  92 (defconst lc-grk    'greek)
  93 (defconst lc-hbw    'hebrew)
  94 (defconst lc-ltn5   'latin-5)
  95 (defconst lc-jp     'japanese)
  96 (defconst lc-jp2    'japanese-2)
  97 (defconst lc-kr     'korean)
  98 (defconst lc-big5-1 'chinese-big5-1)
  99 (defconst lc-big5-2 'chinese-big5-2)
 100 (defconst lc-cn     'chinese-gb)
 101 (defconst lc-cns1   'chinese-cns-1)
 102 (defconst lc-cns2   'chinese-cns-2)
 103 (defconst lc-cns3   'chinese-cns-3)
 104 (defconst lc-cns4   'chinese-cns-4)
 105 (defconst lc-cns5   'chinese-cns-5)
 106 (defconst lc-cns6   'chinese-cns-6)
 107 (defconst lc-cns7   'chinese-cns-7)
 108
 109
 110 ;;; @ coding-system
 111 ;;;
 112
 113 (defconst *noconv* 'noconv)
 114 (defconst *ctext*  'ctext)
 115 (defconst *hz*     'hz)
 116 (defconst *big5*   'big5)
 117 (defconst *euc-kr* 'euc-kr)
 118 (defconst *koi8*   nil)
 119
 120 (defvar code-converter-is-broken
 121   (and xemacs-beta-version (<= xemacs-beta-version 24)))
 122
 123 (if code-converter-is-broken
 124 (progn
 125 ;;;
 126 (defun decode-coding-region (start end coding-system &optional buffer)
 127   "Decode the text between START and END which is encoded in CODING-SYSTEM.
 128 \[emu-x20.el; XEmacs 20 emulating function]"
 129   (save-excursion
 130     (if buffer
 131         (set-buffer buffer)
 132       )
 133     (save-restriction
 134       (narrow-to-region start end)
 135       (let ((process-output-coding-system 'noconv)
 136             (process-input-coding-system coding-system))
 137         (call-process-region start end "cat" t t nil)
 138         ))))
 139
 140 (defun encode-coding-region (start end coding-system &optional buffer)
 141   "Encode the text between START and END which is encoded in CODING-SYSTEM.
 142 \[emu-x20.el; XEmacs 20 emulating function]"
 143   (save-excursion
 144     (if buffer
 145         (set-buffer buffer)
 146       )
 147     (save-restriction
 148       (narrow-to-region start end)
 149       (let ((process-output-coding-system coding-system)
 150             (process-input-coding-system 'noconv))
 151         (call-process-region start end "cat" t t nil)
 152         ))))
 153 ;;;
 154 ))
 155
 156 (defalias 'character-encode-string 'encode-coding-string)
 157 (defalias 'character-decode-string 'decode-coding-string)
 158 (defalias 'character-encode-region 'encode-coding-region)
 159 (defalias 'character-decode-region 'decode-coding-region)
 160
 161
 162 ;;; @ character
 163 ;;;
 164
 165 (defun char-bytes (chr) 1)
 166
 167 (defun char-length (character)
 168   "Return number of elements a CHARACTER occupies in a string or buffer.
 169 \[emu-x20.el]"
 170   1)
 171
 172 (defun char-columns (character)
 173   "Return number of columns a CHARACTER occupies when displayed.
 174 \[emu-x20.el]"
 175   (charset-columns (char-charset character))
 176   )
 177
 178 ;;; @@ Mule emulating aliases
 179 ;;;
 180 ;;; You should not use them.
 181
 182 (defalias 'char-width 'char-columns)
 183
 184 (defalias 'char-leading-char 'char-charset)
 185
 186
 187 ;;; @ string
 188 ;;;
 189
 190 (defun string-columns (string)
 191   "Return number of columns STRING occupies when displayed.
 192 \[emu-x20.el]"
 193   (let ((col 0)
 194         (len (length string))
 195         (i 0))
 196     (while (< i len)
 197       (setq col (+ col (char-columns (aref string i))))
 198       (setq i (1+ i))
 199       )
 200     col))
 201
 202 (defalias 'string-width 'string-column)
 203
 204 (defun string-to-int-list (str)
 205   (mapcar #'char-int str)
 206   )
 207
 208 (defalias 'sref 'aref)
 209
 210 (defun truncate-string (str width &optional start-column)
 211   "Truncate STR to fit in WIDTH columns.
 212 Optional non-nil arg START-COLUMN specifies the starting column.
 213 \[emu-x20.el; Mule 2.3 emulating function]"
 214   (or start-column
 215       (setq start-column 0))
 216   (substring str start-column width)
 217   )
 218
 219
 220 ;;; @ end
 221 ;;;
 222
 223 (provide 'emu-x20)
 224
 225 ;;; emu-x20.el ends here