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 (and (coding-system-property 'iso-2022-jp 'input-charset-conversion)
  35      (copy-coding-system 'iso-2022-7bit 'iso-2022-jp))
  36
  37
  38 ;;; @ without code-conversion
  39 ;;;
  40
  41 (define-obsolete-function-alias 'insert-binary-file-contents
  42   'insert-file-contents-as-binary)
  43
  44 (defun insert-binary-file-contents-literally (filename
  45                                               &optional visit beg end replace)
  46   "Like `insert-file-contents-literally', q.v., but don't code conversion.
  47 A buffer may be modified in several ways after reading into the buffer due
  48 to advanced Emacs features, such as file-name-handlers, format decoding,
  49 find-file-hooks, etc.
  50   This function ensures that none of these modifications will take place."
  51   (let ((coding-system-for-read 'binary))
  52     (insert-file-contents-literally filename visit beg end replace)
  53     ))
  54
  55
  56 ;;; @ MIME charset
  57 ;;;
  58
  59 (defun encode-mime-charset-region (start end charset)
  60   "Encode the text between START and END as MIME CHARSET."
  61   (let ((cs (mime-charset-to-coding-system charset)))
  62     (if cs
  63         (encode-coding-region start end cs)
  64       )))
  65
  66 (defcustom mime-charset-decoder-alist
  67   '((iso-2022-jp . decode-mime-charset-region-with-iso646-unification)
  68     (iso-2022-jp-2 . decode-mime-charset-region-with-iso646-unification)
  69     (x-ctext . decode-mime-charset-region-with-iso646-unification)
  70     (hz-gb-2312 . decode-mime-charset-region-for-hz)
  71     (t . decode-mime-charset-region-default))
  72   "Alist MIME-charset vs. decoder function."
  73   :group 'i18n
  74   :type '(repeat (cons mime-charset function)))
  75
  76 (defsubst decode-mime-charset-region-default (start end charset)
  77   (let ((cs (mime-charset-to-coding-system charset)))
  78     (if cs
  79         (decode-coding-region start end cs)
  80       )))
  81
  82 (defcustom mime-iso646-character-unification-alist
  83   `,(let (dest
  84           (i 33))
  85       (while (< i 92)
  86         (setq dest
  87               (cons (cons (char-to-string (make-char 'latin-jisx0201 i))
  88                           (format "%c" i))
  89                     dest))
  90         (setq i (1+ i)))
  91       (setq i 93)
  92       (while (< i 126)
  93         (setq dest
  94               (cons (cons (char-to-string (make-char 'latin-jisx0201 i))
  95                           (format "%c" i))
  96                     dest))
  97         (setq i (1+ i)))
  98       (nreverse dest))
  99   "Alist unified string vs. canonical string."
 100   :group 'i18n
 101   :type '(repeat (cons string string)))
 102
 103 (defcustom mime-unified-character-face nil
 104   "*Face of unified character."
 105   :group 'i18n
 106   :type 'face)
 107
 108 (defcustom mime-character-unification-limit-size 2048
 109   "*Limit size to unify characters."
 110   :group 'i18n
 111   :type 'integer)
 112
 113 (defun decode-mime-charset-region-with-iso646-unification (start end charset)
 114   (decode-mime-charset-region-default start end charset)
 115   (if (<= (- end start) mime-character-unification-limit-size)
 116       (save-excursion
 117         (let ((rest mime-iso646-character-unification-alist))
 118           (while rest
 119             (let ((pair (car rest)))
 120               (goto-char (point-min))
 121               (while (search-forward (car pair) nil t)
 122                 (let ((str (cdr pair)))
 123                   (put-text-property 0 (length str)
 124                                      'face mime-unified-character-face str)
 125                   (replace-match str 'fixed-case 'literal)
 126                   )
 127                 ))
 128             (setq rest (cdr rest)))))
 129     ))
 130
 131 (defun decode-mime-charset-region-for-hz (start end charset)
 132   (decode-hz-region start end))
 133
 134 (defun decode-mime-charset-region (start end charset)
 135   "Decode the text between START and END as MIME CHARSET."
 136   (if (stringp charset)
 137       (setq charset (intern (downcase charset)))
 138     )
 139   (let ((func (cdr (or (assq charset mime-charset-decoder-alist)
 140                        (assq t mime-charset-decoder-alist)))))
 141     (funcall func start end charset)
 142     ))
 143
 144 (defsubst encode-mime-charset-string (string charset)
 145   "Encode the STRING as MIME CHARSET."
 146   (let ((cs (mime-charset-to-coding-system charset)))
 147     (if cs
 148         (encode-coding-string string cs)
 149       string)))
 150
 151 ;; (defsubst decode-mime-charset-string (string charset)
 152 ;;   "Decode the STRING as MIME CHARSET."
 153 ;;   (let ((cs (mime-charset-to-coding-system charset)))
 154 ;;     (if cs
 155 ;;         (decode-coding-string string cs)
 156 ;;       string)))
 157 (defun decode-mime-charset-string (string charset)
 158   "Decode the STRING as MIME CHARSET."
 159   (with-temp-buffer
 160     (insert string)
 161     (decode-mime-charset-region (point-min)(point-max) charset)
 162     (buffer-string)
 163     ))
 164
 165
 166 (defvar charsets-mime-charset-alist
 167   '(((ascii)                                            . us-ascii)
 168     ((ascii latin-iso8859-1)                            . iso-8859-1)
 169     ((ascii latin-iso8859-2)                            . iso-8859-2)
 170     ((ascii latin-iso8859-3)                            . iso-8859-3)
 171     ((ascii latin-iso8859-4)                            . iso-8859-4)
 172     ((ascii cyrillic-iso8859-5)                         . iso-8859-5)
 173 ;;; ((ascii cyrillic-iso8859-5)                         . koi8-r)
 174     ((ascii arabic-iso8859-6)                           . iso-8859-6)
 175     ((ascii greek-iso8859-7)                            . iso-8859-7)
 176     ((ascii hebrew-iso8859-8)                           . iso-8859-8)
 177     ((ascii latin-iso8859-9)                            . iso-8859-9)
 178     ((ascii latin-jisx0201
 179             japanese-jisx0208-1978 japanese-jisx0208)   . iso-2022-jp)
 180     ((ascii latin-jisx0201
 181             katakana-jisx0201 japanese-jisx0208)        . shift_jis)
 182     ((ascii korean-ksc5601)                             . euc-kr)
 183     ((ascii chinese-gb2312)                             . cn-gb-2312)
 184     ((ascii chinese-big5-1 chinese-big5-2)              . cn-big5)
 185     ((ascii latin-iso8859-1 greek-iso8859-7
 186             latin-jisx0201 japanese-jisx0208-1978
 187             chinese-gb2312 japanese-jisx0208
 188             korean-ksc5601 japanese-jisx0212)           . iso-2022-jp-2)
 189     ((ascii latin-iso8859-1 greek-iso8859-7
 190             latin-jisx0201 japanese-jisx0208-1978
 191             chinese-gb2312 japanese-jisx0208
 192             korean-ksc5601 japanese-jisx0212
 193             chinese-cns11643-1 chinese-cns11643-2)      . iso-2022-int-1)
 194     ((ascii latin-iso8859-1 latin-iso8859-2
 195             cyrillic-iso8859-5 greek-iso8859-7
 196             latin-jisx0201 japanese-jisx0208-1978
 197             chinese-gb2312 japanese-jisx0208
 198             korean-ksc5601 japanese-jisx0212
 199             chinese-cns11643-1 chinese-cns11643-2
 200             chinese-cns11643-3 chinese-cns11643-4
 201             chinese-cns11643-5 chinese-cns11643-6
 202             chinese-cns11643-7)                         . iso-2022-int-1)
 203     ))
 204
 205
 206 ;;; @ buffer representation
 207 ;;;
 208
 209 (defsubst-maybe set-buffer-multibyte (flag)
 210   "Set the multibyte flag of the current buffer to FLAG.
 211 If FLAG is t, this makes the buffer a multibyte buffer.
 212 If FLAG is nil, this makes the buffer a single-byte buffer.
 213 The buffer contents remain unchanged as a sequence of bytes
 214 but the contents viewed as characters do change.
 215 \[Emacs 20.3 emulating function]"
 216   flag)
 217
 218
 219 ;;; @ character
 220 ;;;
 221
 222 ;; avoid bug of XEmacs
 223 (or (integerp (cdr (split-char ?a)))
 224     (defun split-char (char)
 225       "Return list of charset and one or two position-codes of CHAR."
 226       (let ((charset (char-charset char)))
 227         (if (eq charset 'ascii)
 228             (list charset (char-int char))
 229           (let ((i 0)
 230                 (len (charset-dimension charset))
 231                 (code (if (integerp char)
 232                           char
 233                         (char-int char)))
 234                 dest)
 235             (while (< i len)
 236               (setq dest (cons (logand code 127) dest)
 237                     code (lsh code -7)
 238                     i (1+ i)))
 239             (cons charset dest)
 240             ))))
 241     )
 242
 243 (defmacro char-next-index (char index)
 244   "Return index of character succeeding CHAR whose index is INDEX."
 245   `(1+ ,index))
 246
 247 ;;; @@ Mule emulating aliases
 248 ;;;
 249 ;;; You should not use them.
 250
 251 ;;(defalias 'char-leading-char 'char-charset)
 252
 253 (defun char-category (character)
 254   "Return string of category mnemonics for CHAR in TABLE.
 255 CHAR can be any multilingual character
 256 TABLE defaults to the current buffer's category table."
 257   (mapconcat (lambda (chr)
 258                (char-to-string (int-char chr))
 259                )
 260              (char-category-list character)
 261              ""))
 262
 263
 264 ;;; @ string
 265 ;;;
 266
 267 (defun string-to-int-list (str)
 268   (mapcar #'char-int str)
 269   )
 270
 271 (defalias 'looking-at-as-unibyte 'looking-at)
 272
 273
 274 ;;; @ end
 275 ;;;
 276
 277 (provide 'emu-x20)
 278
 279 ;;; emu-x20.el ends here