emu-e20.el

   1 ;;; emu-e20.el --- emu API implementation for Emacs/mule (19.34.91)
   2
   3 ;; Copyright (C) 1996,1997 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Version: $Id: emu-e20.el,v 7.9 1997/01/18 09:35:35 morioka Exp $
   7 ;; Keywords: emulation, compatibility, Mule
   8
   9 ;; This file is part of emu.
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Code:
  27
  28 ;;; @ version specific features
  29 ;;;
  30
  31 (require 'emu-19)
  32
  33 (defun fontset-pixel-size (fontset)
  34   (let* ((info (fontset-info fontset))
  35          (height (aref info 1))
  36          )
  37     (cond ((> height 0) height)
  38           ((string-match "-\\([0-9]+\\)-" fontset)
  39            (string-to-number
  40             (substring fontset (match-beginning 1)(match-end 1))
  41             )
  42            )
  43           (t 0)
  44           )))
  45
  46
  47 ;;; @ character set
  48 ;;;
  49
  50 ;; (defalias 'charset-columns 'charset-width)
  51
  52 (defun find-non-ascii-charset-string (string)
  53   "Return a list of charsets in the STRING except ascii.
  54 \[emu-e20.el; Mule emulating function]"
  55   (delq 'ascii (find-charset-string string))
  56   )
  57
  58 (defun find-non-ascii-charset-region (start end)
  59   "Return a list of charsets except ascii
  60 in the region between START and END.
  61 \[emu-e20.el; Mule emulating function]"
  62   (delq 'ascii (find-charset-string (buffer-substring start end)))
  63   )
  64
  65
  66 ;;; @ coding system
  67 ;;;
  68
  69 (defconst *noconv* 'no-conversion)
  70
  71 (defmacro as-binary-process (&rest body)
  72   `(let (selective-display      ; Disable ^M to nl translation.
  73          ;; for Emacs/mule
  74          (coding-system-for-read  'no-conversion)
  75          (coding-system-for-write 'no-conversion)
  76          )
  77      ,@ body))
  78
  79 (defmacro as-binary-input-file (&rest body)
  80   `(let ((coding-system-for-read 'no-conversion))
  81      ,@body))
  82
  83 (defalias 'set-process-input-coding-system 'set-process-coding-system)
  84
  85
  86 ;;; @ MIME charset
  87 ;;;
  88
  89 (defvar charsets-mime-charset-alist
  90   '(((ascii)                                            . us-ascii)
  91     ((ascii latin-iso8859-1)                            . iso-8859-1)
  92     ((ascii latin-iso8859-2)                            . iso-8859-2)
  93     ((ascii latin-iso8859-3)                            . iso-8859-3)
  94     ((ascii latin-iso8859-4)                            . iso-8859-4)
  95 ;;; ((ascii cyrillic-iso8859-5)                         . iso-8859-5)
  96     ((ascii cyrillic-iso8859-5)                         . koi8-r)
  97     ((ascii arabic-iso8859-6)                           . iso-8859-6)
  98     ((ascii greek-iso8859-7)                            . iso-8859-7)
  99     ((ascii hebrew-iso8859-8)                           . iso-8859-8)
 100     ((ascii latin-iso8859-9)                            . iso-8859-9)
 101     ((ascii latin-jisx0201
 102             japanese-jisx0208-1978 japanese-jisx0208)   . iso-2022-jp)
 103     ((ascii korean-ksc5601)                             . euc-kr)
 104     ((ascii chinese-gb2312)                             . cn-gb-2312)
 105     ((ascii chinese-big5-1 chinese-big5-2)              . cn-big5)
 106     ((ascii latin-iso8859-1 greek-iso8859-7
 107             latin-jisx0201 japanese-jisx0208-1978
 108             chinese-gb2312 japanese-jisx0208
 109             korean-ksc5601 japanese-jisx0212)           . iso-2022-jp-2)
 110     ((ascii latin-iso8859-1 greek-iso8859-7
 111             latin-jisx0201 japanese-jisx0208-1978
 112             chinese-gb2312 japanese-jisx0208
 113             korean-ksc5601 japanese-jisx0212
 114             chinese-cns11643-1 chinese-cns11643-2)      . iso-2022-int-1)
 115     ((ascii latin-iso8859-1 latin-iso8859-2
 116             cyrillic-iso8859-5 greek-iso8859-7
 117             latin-jisx0201 japanese-jisx0208-1978
 118             chinese-gb2312 japanese-jisx0208
 119             korean-ksc5601 japanese-jisx0212
 120             chinese-cns11643-1 chinese-cns11643-2
 121             chinese-cns11643-3 chinese-cns11643-4
 122             chinese-cns11643-5 chinese-cns11643-6
 123             chinese-cns11643-7)                         . iso-2022-int-1)
 124     ))
 125
 126 (defvar default-mime-charset 'x-ctext)
 127
 128 (defvar mime-charset-coding-system-alist
 129   '((x-ctext            . coding-system-ctext)
 130     (hz-gb-2312         . coding-system-hz)
 131     (cn-gb-2312         . coding-system-euc-china)
 132     (gb2312             . coding-system-euc-china)
 133     (cn-big5            . coding-system-big5)
 134     (iso-2022-jp-2      . coding-system-iso-2022-ss2-7)
 135     (iso-2022-int-1     . coding-system-iso-2022-int)
 136     (shift_jis          . coding-system-sjis)
 137     ))
 138
 139 (defun mime-charset-to-coding-system (charset &optional lbt)
 140   (if (stringp charset)
 141       (setq charset (intern (downcase charset)))
 142     )
 143   (let ((cs
 144          (or (cdr (assq charset mime-charset-coding-system-alist))
 145              (let ((cs (intern (concat "coding-system-"
 146                                        (symbol-name charset)))))
 147                (and (coding-system-p cs) cs)
 148                ))))
 149     (if lbt
 150         (intern (concat (symbol-name cs) "-" (symbol-name lbt)))
 151       cs)))
 152
 153 (defun detect-mime-charset-region (start end)
 154   "Return MIME charset for region between START and END. [emu-e20.el]"
 155   (charsets-to-mime-charset
 156    (find-charset-string (buffer-substring start end))
 157    ))
 158
 159 (defun encode-mime-charset-region (start end charset)
 160   "Encode the text between START and END as MIME CHARSET. [emu-e20.el]"
 161   (let ((cs (mime-charset-to-coding-system charset)))
 162     (if cs
 163         (encode-coding-region start end cs)
 164       )))
 165
 166 (defun decode-mime-charset-region (start end charset)
 167   "Decode the text between START and END as MIME CHARSET. [emu-e20.el]"
 168   (let ((cs (mime-charset-to-coding-system charset)))
 169     (if cs
 170         (decode-coding-region start end cs)
 171       )))
 172
 173 (defun encode-mime-charset-string (string charset)
 174   "Encode the STRING as MIME CHARSET. [emu-e20.el]"
 175   (let ((cs (mime-charset-to-coding-system charset)))
 176     (if cs
 177         (encode-coding-string string cs)
 178       string)))
 179
 180 (defun decode-mime-charset-string (string charset)
 181   "Decode the STRING as MIME CHARSET. [emu-e20.el]"
 182   (let ((cs (mime-charset-to-coding-system charset)))
 183     (if cs
 184         (decode-coding-string string cs)
 185       string)))
 186
 187
 188 ;;; @ character
 189 ;;;
 190
 191 (defalias 'char-length 'char-bytes)
 192
 193 (defalias 'char-columns 'char-width)
 194
 195
 196 ;;; @@ Mule emulating aliases
 197 ;;;
 198 ;;; You should not use them.
 199
 200 (defalias 'make-character 'make-char)
 201
 202 (defun char-category (character)
 203   "Return string of category mnemonics for CHAR in TABLE.
 204 CHAR can be any multilingual character
 205 TABLE defaults to the current buffer's category table.
 206 \[emu-e20.el; Mule emulating function]"
 207   (category-set-mnemonics (char-category-set character))
 208   )
 209
 210
 211 ;;; @ string
 212 ;;;
 213
 214 (defalias 'string-columns 'string-width)
 215
 216 (defalias 'sset 'store-substring)
 217
 218 (defun string-to-char-list (string)
 219   "Return a list of which elements are characters in the STRING.
 220 \[emu-e20.el; Mule 2.3 emulating function]"
 221   (let* ((len (length string))
 222          (i 0)
 223          l chr)
 224     (while (< i len)
 225       (setq chr (sref string i))
 226       (setq l (cons chr l))
 227       (setq i (+ i (char-bytes chr)))
 228       )
 229     (nreverse l)
 230     ))
 231
 232 (defalias 'string-to-int-list 'string-to-char-list)
 233
 234
 235 ;;; @ regulation
 236 ;;;
 237
 238 ;; (defun regulate-latin-char (chr)
 239 ;;   (cond ((and (<= ?\e$B#A\e(B chr)(<= chr ?\e$B#Z\e(B))
 240 ;;          (+ (- chr ?\e$B#A\e(B) ?A)
 241 ;;          )
 242 ;;         ((and (<= ?\e$B#a\e(B chr)(<= chr ?\e$B#z\e(B))
 243 ;;          (+ (- chr ?\e$B#a\e(B) ?a)
 244 ;;          )
 245 ;;         ((eq chr ?\e$B!%\e(B) ?.)
 246 ;;         ((eq chr ?\e$B!$\e(B) ?,)
 247 ;;         (t chr)
 248 ;;         ))
 249
 250 ;; (defun regulate-latin-string (str)
 251 ;;   (let ((len (length str))
 252 ;;         (i 0)
 253 ;;         chr (dest ""))
 254 ;;     (while (< i len)
 255 ;;       (setq chr (sref str i))
 256 ;;       (setq dest (concat dest
 257 ;;                          (char-to-string (regulate-latin-char chr))))
 258 ;;       (setq i (+ i (char-bytes chr)))
 259 ;;       )
 260 ;;     dest))
 261
 262
 263 ;;; @ end
 264 ;;;
 265
 266 (provide 'emu-e20)
 267
 268 ;;; emu-e20.el ends here