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