emu-x20.el

   1 ;;; emu-x20.el --- emu API implementation for XEmacs with mule
   2
   3 ;; Copyright (C) 1994,1995,1996,1997,1998 MORIOKA Tomohiko
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Keywords: emulation, compatibility, Mule, XEmacs
   7
   8 ;; This file is part of emu.
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or (at
  13 ;; your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;    This module requires XEmacs 20.3-b5 or later with mule.
  28
  29 ;;; Code:
  30
  31 (require 'emu-20)
  32
  33
  34 ;;; @ fix coding-system definition
  35 ;;;
  36
  37 ;; It seems not bug, but I can not permit it...
  38 (and (coding-system-property 'iso-2022-jp 'input-charset-conversion)
  39      (copy-coding-system 'iso-2022-7bit 'iso-2022-jp))
  40
  41 ;; Redefine if -{dos|mac|unix} is not found.
  42 (or (find-coding-system 'raw-text-dos)
  43     (copy-coding-system 'no-conversion-dos 'raw-text-dos))
  44 (or (find-coding-system 'raw-text-mac)
  45     (copy-coding-system 'no-conversion-mac 'raw-text-mac))
  46 (or (find-coding-system 'raw-text-unix)
  47     (copy-coding-system 'no-conversion-unix 'raw-text-unix))
  48
  49 (or (find-coding-system 'ctext-dos)
  50     (make-coding-system
  51      'ctext 'iso2022
  52      "Coding-system used in X as Compound Text Encoding."
  53      '(charset-g0 ascii charset-g1 latin-iso8859-1
  54                   eol-type nil
  55                   mnemonic "CText")))
  56
  57 (or (find-coding-system 'iso-2022-jp-2-dos)
  58     (make-coding-system
  59      'iso-2022-jp-2 'iso2022
  60      "ISO-2022 coding system using SS2 for 96-charset in 7-bit code."
  61      '(charset-g0 ascii
  62        charset-g2 t ;; unspecified but can be used later.
  63        seven t
  64        short t
  65        mnemonic "ISO7/SS2"
  66        eol-type nil)))
  67
  68 (or (find-coding-system 'euc-kr-dos)
  69     (make-coding-system
  70      'euc-kr 'iso2022
  71      "Coding-system of Korean EUC (Extended Unix Code)."
  72      '(charset-g0 ascii charset-g1 korean-ksc5601
  73                   mnemonic "ko/EUC"
  74                   eol-type nil)))
  75
  76
  77 ;;; @ CCL
  78 ;;;
  79
  80 (defun make-ccl-coding-system (name mnemonic doc-string decoder encoder)
  81   (make-coding-system
  82    name 'ccl doc-string
  83    (list 'mnemonic (char-to-string mnemonic)
  84          'decode (symbol-value decoder)
  85          'encode (symbol-value encoder))))
  86
  87
  88 ;;; @ without code-conversion
  89 ;;;
  90
  91 (define-obsolete-function-alias 'insert-binary-file-contents
  92   'insert-file-contents-as-binary)
  93
  94 (defun insert-binary-file-contents-literally (filename
  95                                               &optional visit beg end replace)
  96   "Like `insert-file-contents-literally', q.v., but don't code conversion.
  97 A buffer may be modified in several ways after reading into the buffer due
  98 to advanced Emacs features, such as file-name-handlers, format decoding,
  99 find-file-hooks, etc.
 100   This function ensures that none of these modifications will take place."
 101   (let ((coding-system-for-read 'binary))
 102     ;; Returns list absolute file name and length of data inserted.
 103     (insert-file-contents-literally filename visit beg end replace)))
 104
 105
 106 ;;; @ MIME charset
 107 ;;;
 108
 109 (defun encode-mime-charset-region (start end charset)
 110   "Encode the text between START and END as MIME CHARSET."
 111   (let ((cs (mime-charset-to-coding-system charset)))
 112     (if cs
 113         (encode-coding-region start end cs)
 114       )))
 115
 116 (defcustom mime-charset-decoder-alist
 117   '((iso-2022-jp . decode-mime-charset-region-with-iso646-unification)
 118     (iso-2022-jp-2 . decode-mime-charset-region-with-iso646-unification)
 119     (x-ctext . decode-mime-charset-region-with-iso646-unification)
 120     (hz-gb-2312 . decode-mime-charset-region-for-hz)
 121     (t . decode-mime-charset-region-default))
 122   "Alist MIME-charset vs. decoder function."
 123   :group 'i18n
 124   :type '(repeat (cons mime-charset function)))
 125
 126 (defsubst decode-mime-charset-region-default (start end charset lbt)
 127   (let ((cs (mime-charset-to-coding-system charset lbt)))
 128     (if cs
 129         (decode-coding-region start end cs)
 130       )))
 131
 132 (defcustom mime-iso646-character-unification-alist
 133   `,(let (dest
 134           (i 33))
 135       (while (< i 92)
 136         (setq dest
 137               (cons (cons (char-to-string (make-char 'latin-jisx0201 i))
 138                           (format "%c" i))
 139                     dest))
 140         (setq i (1+ i)))
 141       (setq i 93)
 142       (while (< i 126)
 143         (setq dest
 144               (cons (cons (char-to-string (make-char 'latin-jisx0201 i))
 145                           (format "%c" i))
 146                     dest))
 147         (setq i (1+ i)))
 148       (nreverse dest))
 149   "Alist unified string vs. canonical string."
 150   :group 'i18n
 151   :type '(repeat (cons string string)))
 152
 153 (defcustom mime-unified-character-face nil
 154   "*Face of unified character."
 155   :group 'i18n
 156   :type 'face)
 157
 158 (defcustom mime-character-unification-limit-size 2048
 159   "*Limit size to unify characters."
 160   :group 'i18n
 161   :type 'integer)
 162
 163 (defun decode-mime-charset-region-with-iso646-unification (start end charset
 164                                                                  lbt)
 165   (decode-mime-charset-region-default start end charset lbt)
 166   (if (<= (- end start) mime-character-unification-limit-size)
 167       (save-excursion
 168         (let ((rest mime-iso646-character-unification-alist))
 169           (while rest
 170             (let ((pair (car rest)))
 171               (goto-char (point-min))
 172               (while (search-forward (car pair) nil t)
 173                 (let ((str (cdr pair)))
 174                   (put-text-property 0 (length str)
 175                                      'face mime-unified-character-face str)
 176                   (replace-match str 'fixed-case 'literal)
 177                   )
 178                 ))
 179             (setq rest (cdr rest)))))
 180     ))
 181
 182 (defun decode-mime-charset-region-for-hz (start end charset lbt)
 183   (if lbt
 184       (save-restriction
 185         (narrow-to-region start end)
 186         (decode-coding-region (point-min)(point-max)
 187                               (mime-charset-to-coding-system 'raw-text lbt))
 188         (decode-hz-region (point-min)(point-max)))
 189     (decode-hz-region start end)))
 190
 191 (defun decode-mime-charset-region (start end charset &optional lbt)
 192   "Decode the text between START and END as MIME CHARSET."
 193   (if (stringp charset)
 194       (setq charset (intern (downcase charset)))
 195     )
 196   (let ((func (cdr (or (assq charset mime-charset-decoder-alist)
 197                        (assq t mime-charset-decoder-alist)))))
 198     (funcall func start end charset lbt)))
 199
 200 (defsubst encode-mime-charset-string (string charset)
 201   "Encode the STRING as MIME CHARSET."
 202   (let ((cs (mime-charset-to-coding-system charset)))
 203     (if cs
 204         (encode-coding-string string cs)
 205       string)))
 206
 207 ;; (defsubst decode-mime-charset-string (string charset)
 208 ;;   "Decode the STRING as MIME CHARSET."
 209 ;;   (let ((cs (mime-charset-to-coding-system charset)))
 210 ;;     (if cs
 211 ;;         (decode-coding-string string cs)
 212 ;;       string)))
 213 (defun decode-mime-charset-string (string charset &optional lbt)
 214   "Decode the STRING as MIME CHARSET."
 215   (with-temp-buffer
 216     (insert string)
 217     (decode-mime-charset-region (point-min)(point-max) charset lbt)
 218     (buffer-string)))
 219
 220
 221 (defvar charsets-mime-charset-alist
 222   '(((ascii)                                            . us-ascii)
 223     ((ascii latin-iso8859-1)                            . iso-8859-1)
 224     ((ascii latin-iso8859-2)                            . iso-8859-2)
 225     ((ascii latin-iso8859-3)                            . iso-8859-3)
 226     ((ascii latin-iso8859-4)                            . iso-8859-4)
 227     ((ascii cyrillic-iso8859-5)                         . iso-8859-5)
 228 ;;; ((ascii cyrillic-iso8859-5)                         . koi8-r)
 229     ((ascii arabic-iso8859-6)                           . iso-8859-6)
 230     ((ascii greek-iso8859-7)                            . iso-8859-7)
 231     ((ascii hebrew-iso8859-8)                           . iso-8859-8)
 232     ((ascii latin-iso8859-9)                            . iso-8859-9)
 233     ((ascii latin-jisx0201
 234             japanese-jisx0208-1978 japanese-jisx0208)   . iso-2022-jp)
 235     ((ascii latin-jisx0201
 236             katakana-jisx0201 japanese-jisx0208)        . shift_jis)
 237     ((ascii korean-ksc5601)                             . euc-kr)
 238     ((ascii chinese-gb2312)                             . cn-gb-2312)
 239     ((ascii chinese-big5-1 chinese-big5-2)              . cn-big5)
 240     ((ascii latin-iso8859-1 greek-iso8859-7
 241             latin-jisx0201 japanese-jisx0208-1978
 242             chinese-gb2312 japanese-jisx0208
 243             korean-ksc5601 japanese-jisx0212)           . iso-2022-jp-2)
 244     ((ascii latin-iso8859-1 greek-iso8859-7
 245             latin-jisx0201 japanese-jisx0208-1978
 246             chinese-gb2312 japanese-jisx0208
 247             korean-ksc5601 japanese-jisx0212
 248             chinese-cns11643-1 chinese-cns11643-2)      . iso-2022-int-1)
 249     ((ascii latin-iso8859-1 latin-iso8859-2
 250             cyrillic-iso8859-5 greek-iso8859-7
 251             latin-jisx0201 japanese-jisx0208-1978
 252             chinese-gb2312 japanese-jisx0208
 253             korean-ksc5601 japanese-jisx0212
 254             chinese-cns11643-1 chinese-cns11643-2
 255             chinese-cns11643-3 chinese-cns11643-4
 256             chinese-cns11643-5 chinese-cns11643-6
 257             chinese-cns11643-7)                         . iso-2022-int-1)
 258     ))
 259
 260
 261 ;;; @ buffer representation
 262 ;;;
 263
 264 (defsubst-maybe set-buffer-multibyte (flag)
 265   "Set the multibyte flag of the current buffer to FLAG.
 266 If FLAG is t, this makes the buffer a multibyte buffer.
 267 If FLAG is nil, this makes the buffer a single-byte buffer.
 268 The buffer contents remain unchanged as a sequence of bytes
 269 but the contents viewed as characters do change.
 270 \[Emacs 20.3 emulating function]"
 271   flag)
 272
 273
 274 ;;; @ character
 275 ;;;
 276
 277 ;; avoid bug of XEmacs
 278 (or (integerp (cdr (split-char ?a)))
 279     (defun split-char (char)
 280       "Return list of charset and one or two position-codes of CHAR."
 281       (let ((charset (char-charset char)))
 282         (if (eq charset 'ascii)
 283             (list charset (char-int char))
 284           (let ((i 0)
 285                 (len (charset-dimension charset))
 286                 (code (if (integerp char)
 287                           char
 288                         (char-int char)))
 289                 dest)
 290             (while (< i len)
 291               (setq dest (cons (logand code 127) dest)
 292                     code (lsh code -7)
 293                     i (1+ i)))
 294             (cons charset dest)))))
 295     )
 296
 297 (defmacro char-next-index (char index)
 298   "Return index of character succeeding CHAR whose index is INDEX."
 299   `(1+ ,index))
 300
 301 ;;; @@ Mule emulating aliases
 302 ;;;
 303 ;;; You should not use them.
 304
 305 ;;(defalias 'char-leading-char 'char-charset)
 306
 307 (defun char-category (character)
 308   "Return string of category mnemonics for CHAR in TABLE.
 309 CHAR can be any multilingual character
 310 TABLE defaults to the current buffer's category table."
 311   (mapconcat (lambda (chr)
 312                (char-to-string (int-char chr)))
 313              (char-category-list character)
 314              ""))
 315
 316
 317 ;;; @ string
 318 ;;;
 319
 320 (defun string-to-int-list (str)
 321   (mapcar #'char-int str))
 322
 323 (defalias 'looking-at-as-unibyte 'looking-at)
 324
 325
 326 ;;; @ end
 327 ;;;
 328
 329 (provide 'emu-x20)
 330
 331 ;;; emu-x20.el ends here