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