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.11 1996/05/27 14:09:18 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 ;;; @@ for Mule emulation
  70 ;;;
  71
  72 (defconst lc-ascii  'ascii)
  73 (defconst lc-ltn1   'latin-1)
  74 (defconst lc-ltn2   'latin-2)
  75 (defconst lc-ltn3   'latin-3)
  76 (defconst lc-ltn4   'latin-4)
  77 (defconst lc-crl    'cyrillic)
  78 (defconst lc-arb    'arabic)
  79 (defconst lc-grk    'greek)
  80 (defconst lc-hbw    'hebrew)
  81 (defconst lc-ltn5   'latin-5)
  82 (defconst lc-jp     'japanese)
  83 (defconst lc-jp2    'japanese-2)
  84 (defconst lc-kr     'korean)
  85 (defconst lc-big5-1 'chinese-big5-1)
  86 (defconst lc-big5-2 'chinese-big5-2)
  87 (defconst lc-cn     'chinese-gb)
  88 (defconst lc-cns1   'chinese-cns-1)
  89 (defconst lc-cns2   'chinese-cns-2)
  90 (defconst lc-cns3   'chinese-cns-3)
  91 (defconst lc-cns4   'chinese-cns-4)
  92 (defconst lc-cns5   'chinese-cns-5)
  93 (defconst lc-cns6   'chinese-cns-6)
  94 (defconst lc-cns7   'chinese-cns-7)
  95
  96
  97 ;;; @ coding-system
  98 ;;;
  99
 100 (defconst *noconv* 'noconv)
 101 (defconst *ctext*  'ctext)
 102 (defconst *hz*     'hz)
 103 (defconst *big5*   'big5)
 104 (defconst *euc-kr* 'euc-kr)
 105 (defconst *koi8*   nil)
 106
 107 (defvar code-converter-is-broken
 108   (and xemacs-beta-version (<= xemacs-beta-version 20)))
 109
 110 (if code-converter-is-broken
 111 (progn
 112 ;;;
 113 (defun decode-coding-region (start end coding-system &optional buffer)
 114   "Decode the text between START and END which is encoded in CODING-SYSTEM.
 115 \[emu-x20.el; XEmacs 20 emulating function]"
 116   (save-excursion
 117     (if buffer
 118         (set-buffer buffer)
 119       )
 120     (save-restriction
 121       (narrow-to-region start end)
 122       (let ((process-output-coding-system 'noconv)
 123             (process-input-coding-system coding-system))
 124         (call-process-region start end "cat" t t nil)
 125         ))))
 126
 127 (defun encode-coding-region (start end coding-system &optional buffer)
 128   "Encode the text between START and END which is encoded in CODING-SYSTEM.
 129 \[emu-x20.el; XEmacs 20 emulating function]"
 130   (save-excursion
 131     (if buffer
 132         (set-buffer buffer)
 133       )
 134     (save-restriction
 135       (narrow-to-region start end)
 136       (let ((process-output-coding-system coding-system)
 137             (process-input-coding-system 'noconv))
 138         (call-process-region start end "cat" t t nil)
 139         ))))
 140 ;;;
 141 ))
 142
 143 (defalias 'character-encode-string 'encode-coding-string)
 144 (defalias 'character-decode-string 'decode-coding-string)
 145 (defalias 'character-encode-region 'encode-coding-region)
 146 (defalias 'character-decode-region 'decode-coding-region)
 147
 148
 149 ;;; @ character
 150 ;;;
 151
 152 (defun char-bytes (chr) 1)
 153
 154 (defun char-columns (character)
 155   "Return number of columns a CHARACTER occupies when displayed.
 156 \[emu-x20.el]"
 157   (charset-columns (char-charset character))
 158   )
 159
 160 ;;; @@ Mule emulating aliases
 161 ;;;
 162 ;;; You should not use them.
 163
 164 (defalias 'char-width 'char-columns)
 165
 166 (defalias 'char-leading-char 'char-charset)
 167
 168
 169 ;;; @ string
 170 ;;;
 171
 172 (defun string-columns (string)
 173   "Return number of columns STRING occupies when displayed.
 174 \[emu-x20.el]"
 175   (let ((col 0)
 176         (len (length string))
 177         (i 0))
 178     (while (< i len)
 179       (setq col (+ col (char-columns (aref string i))))
 180       (setq i (1+ i))
 181       )
 182     col))
 183
 184 (defalias 'string-width 'string-column)
 185
 186 (defun string-to-int-list (str)
 187   (mapcar #'char-int str)
 188   )
 189
 190 (defalias 'sref 'aref)
 191
 192 (defun truncate-string (str width &optional start-column)
 193   "Truncate STR to fit in WIDTH columns.
 194 Optional non-nil arg START-COLUMN specifies the starting column.
 195 \[emu-x20.el; Mule 2.3 emulating function]"
 196   (or start-column
 197       (setq start-column 0))
 198   (substring str start-column width)
 199   )
 200
 201 (defun find-charset-string (string)
 202   "Return a list of charsets in the STRING except ascii.
 203 \[emu-x20.el; Mule emulating function]"
 204   (delq 'ascii (charsets-in-string string))
 205   )
 206
 207 (defun find-charset-region (start end)
 208   "Return a list of charsets except ascii
 209 in the region between START and END.
 210 \[emu-x20.el; Mule emulating function]"
 211   (delq 'ascii (charsets-in-region start end))
 212   )
 213
 214
 215 ;;; @ end
 216 ;;;
 217
 218 (provide 'emu-x20)
 219
 220 ;;; emu-x20.el ends here