emu-e20.el

   1 ;;; emu-e20.el --- emu API implementation for Emacs/mule (19.34.91-delta)
   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.15 1997/07/13 06:23:00 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 ;;; Commentary:
  27
  28 ;;    This module requires Emacs 20.0.90 or later.
  29
  30 ;;; Code:
  31
  32 ;;; @ version specific features
  33 ;;;
  34
  35 (require 'emu-19)
  36
  37 (defun fontset-pixel-size (fontset)
  38   (let* ((info (fontset-info fontset))
  39          (height (aref info 1))
  40          )
  41     (cond ((> height 0) height)
  42           ((string-match "-\\([0-9]+\\)-" fontset)
  43            (string-to-number
  44             (substring fontset (match-beginning 1)(match-end 1))
  45             )
  46            )
  47           (t 0)
  48           )))
  49
  50
  51 ;;; @ character set
  52 ;;;
  53
  54 ;; (defalias 'charset-columns 'charset-width)
  55
  56 (defun find-non-ascii-charset-string (string)
  57   "Return a list of charsets in the STRING except ascii."
  58   (delq 'ascii (find-charset-string string))
  59   )
  60
  61 (defun find-non-ascii-charset-region (start end)
  62   "Return a list of charsets except ascii
  63 in the region between START and END."
  64   (delq 'ascii (find-charset-string (buffer-substring start end)))
  65   )
  66
  67
  68 ;;; @ coding system
  69 ;;;
  70
  71 (defconst *noconv* 'no-conversion)
  72
  73 (defmacro as-binary-process (&rest body)
  74   `(let (selective-display      ; Disable ^M to nl translation.
  75          ;; for Emacs/mule
  76          (coding-system-for-read  'no-conversion)
  77          (coding-system-for-write 'no-conversion)
  78          )
  79      ,@ body))
  80
  81 (defmacro as-binary-input-file (&rest body)
  82   `(let ((coding-system-for-read 'no-conversion))
  83      ,@body))
  84
  85 (defmacro as-binary-output-file (&rest body)
  86   `(let ((coding-system-for-write 'no-conversion))
  87      ,@body))
  88
  89 (defalias 'set-process-input-coding-system 'set-process-coding-system)
  90
  91
  92 ;;; @ binary access
  93 ;;;
  94
  95 (defun insert-binary-file-contents-literally
  96   (filename &optional visit beg end replace)
  97   "Like `insert-file-contents-literally', q.v., but don't code conversion.
  98 A buffer may be modified in several ways after reading into the buffer due
  99 to advanced Emacs features, such as file-name-handlers, format decoding,
 100 find-file-hooks, etc.
 101   This function ensures that none of these modifications will take place."
 102   (let ((coding-system-for-read 'no-conversion))
 103     (insert-file-contents-literally filename visit beg end replace)
 104     ))
 105
 106
 107 ;;; @ MIME charset
 108 ;;;
 109
 110 (defvar charsets-mime-charset-alist
 111   '(((ascii)                                            . us-ascii)
 112     ((ascii latin-iso8859-1)                            . iso-8859-1)
 113     ((ascii latin-iso8859-2)                            . iso-8859-2)
 114     ((ascii latin-iso8859-3)                            . iso-8859-3)
 115     ((ascii latin-iso8859-4)                            . iso-8859-4)
 116 ;;; ((ascii cyrillic-iso8859-5)                         . iso-8859-5)
 117     ((ascii cyrillic-iso8859-5)                         . koi8-r)
 118     ((ascii arabic-iso8859-6)                           . iso-8859-6)
 119     ((ascii greek-iso8859-7)                            . iso-8859-7)
 120     ((ascii hebrew-iso8859-8)                           . iso-8859-8)
 121     ((ascii latin-iso8859-9)                            . iso-8859-9)
 122     ((ascii latin-jisx0201
 123             japanese-jisx0208-1978 japanese-jisx0208)   . iso-2022-jp)
 124     ((ascii korean-ksc5601)                             . euc-kr)
 125     ((ascii chinese-gb2312)                             . cn-gb-2312)
 126     ((ascii chinese-big5-1 chinese-big5-2)              . cn-big5)
 127     ((ascii latin-iso8859-1 greek-iso8859-7
 128             latin-jisx0201 japanese-jisx0208-1978
 129             chinese-gb2312 japanese-jisx0208
 130             korean-ksc5601 japanese-jisx0212)           . iso-2022-jp-2)
 131     ((ascii latin-iso8859-1 greek-iso8859-7
 132             latin-jisx0201 japanese-jisx0208-1978
 133             chinese-gb2312 japanese-jisx0208
 134             korean-ksc5601 japanese-jisx0212
 135             chinese-cns11643-1 chinese-cns11643-2)      . iso-2022-int-1)
 136     ((ascii latin-iso8859-1 latin-iso8859-2
 137             cyrillic-iso8859-5 greek-iso8859-7
 138             latin-jisx0201 japanese-jisx0208-1978
 139             chinese-gb2312 japanese-jisx0208
 140             korean-ksc5601 japanese-jisx0212
 141             chinese-cns11643-1 chinese-cns11643-2
 142             chinese-cns11643-3 chinese-cns11643-4
 143             chinese-cns11643-5 chinese-cns11643-6
 144             chinese-cns11643-7)                         . iso-2022-int-1)
 145     ))
 146
 147 (defvar default-mime-charset 'x-ctext)
 148
 149 (defvar mime-charset-coding-system-alist
 150   '((x-ctext            . ctext)
 151     (gb2312             . cn-gb-2312)
 152     (iso-2022-jp-2      . iso-2022-7bit-ss2)
 153     ))
 154
 155 (defun mime-charset-to-coding-system (charset &optional lbt)
 156   "Return coding-system corresponding with charset.
 157 If optional argument LBT (`unix', `dos' or `mac') is specified, it is
 158 used as line break code type of coding-system."
 159   (if (stringp charset)
 160       (setq charset (intern (downcase charset)))
 161     )
 162   (let ((cs
 163          (or (cdr (assq charset mime-charset-coding-system-alist))
 164              (and (coding-system-p charset) charset)
 165              )))
 166     (if lbt
 167         (intern (concat (symbol-name cs) "-" (symbol-name lbt)))
 168       cs)))
 169
 170 (defun detect-mime-charset-region (start end)
 171   "Return MIME charset for region between START and END."
 172   (charsets-to-mime-charset
 173    (find-charset-string (buffer-substring start end))
 174    ))
 175
 176 (defun encode-mime-charset-region (start end charset)
 177   "Encode the text between START and END as MIME CHARSET."
 178   (let ((cs (mime-charset-to-coding-system charset)))
 179     (if cs
 180         (encode-coding-region start end cs)
 181       )))
 182
 183 (defun decode-mime-charset-region (start end charset)
 184   "Decode the text between START and END as MIME CHARSET."
 185   (let ((cs (mime-charset-to-coding-system charset)))
 186     (if cs
 187         (decode-coding-region start end cs)
 188       )))
 189
 190 (defun encode-mime-charset-string (string charset)
 191   "Encode the STRING as MIME CHARSET."
 192   (let ((cs (mime-charset-to-coding-system charset)))
 193     (if cs
 194         (encode-coding-string string cs)
 195       string)))
 196
 197 (defun decode-mime-charset-string (string charset)
 198   "Decode the STRING as MIME CHARSET."
 199   (let ((cs (mime-charset-to-coding-system charset)))
 200     (if cs
 201         (decode-coding-string string cs)
 202       string)))
 203
 204
 205 ;;; @ character
 206 ;;;
 207
 208 (defalias 'char-length 'char-bytes)
 209
 210 (defalias 'char-columns 'char-width)
 211
 212
 213 ;;; @@ Mule emulating aliases
 214 ;;;
 215 ;;; You should not use them.
 216
 217 (defun char-category (character)
 218   "Return string of category mnemonics for CHAR in TABLE.
 219 CHAR can be any multilingual character
 220 TABLE defaults to the current buffer's category table."
 221   (category-set-mnemonics (char-category-set character))
 222   )
 223
 224
 225 ;;; @ string
 226 ;;;
 227
 228 (defalias 'string-columns 'string-width)
 229
 230 (defalias 'sset 'store-substring)
 231
 232 (defun string-to-char-list (string)
 233   "Return a list of which elements are characters in the STRING."
 234   (let* ((len (length string))
 235          (i 0)
 236          l chr)
 237     (while (< i len)
 238       (setq chr (sref string i))
 239       (setq l (cons chr l))
 240       (setq i (+ i (char-bytes chr)))
 241       )
 242     (nreverse l)
 243     ))
 244
 245 (defalias 'string-to-int-list 'string-to-char-list)
 246
 247
 248 ;;; @ end
 249 ;;;
 250
 251 (provide 'emu-e20)
 252
 253 ;;; emu-e20.el ends here