1 ;;; emu-e20.el --- emu API implementation for Emacs 20.1 and 20.2
3 ;; Copyright (C) 1996,1997,1998 Free Software Foundation, Inc.
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; Keywords: emulation, compatibility, Mule
8 ;; This file is part of emu.
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.
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.
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.
27 ;; This module requires Emacs 20.1 and 20.2.
33 (defun fontset-pixel-size (fontset)
34 (let* ((info (fontset-info fontset))
35 (height (aref info 1))
37 (cond ((> height 0) height)
38 ((string-match "-\\([0-9]+\\)-" fontset)
40 (substring fontset (match-beginning 1)(match-end 1))))
47 ;; (defalias 'charset-columns 'charset-width)
49 (defun find-non-ascii-charset-string (string)
50 "Return a list of charsets in the STRING except ascii."
51 (delq 'ascii (find-charset-string string)))
53 (defun find-non-ascii-charset-region (start end)
54 "Return a list of charsets except ascii
55 in the region between START and END."
56 (delq 'ascii (find-charset-string (buffer-substring start end))))
62 (defsubst-maybe find-coding-system (obj)
63 "Return OBJ if it is a coding-system."
64 (if (coding-system-p obj)
67 (defalias 'set-process-input-coding-system 'set-process-coding-system)
73 (defsubst encode-mime-charset-region (start end charset)
74 "Encode the text between START and END as MIME CHARSET."
76 (if (and enable-multibyte-characters
77 (setq cs (mime-charset-to-coding-system charset)))
78 (encode-coding-region start end cs)
81 (defsubst decode-mime-charset-region (start end charset &optional lbt)
82 "Decode the text between START and END as MIME CHARSET."
84 (if (and enable-multibyte-characters
85 (setq cs (mime-charset-to-coding-system charset lbt)))
86 (decode-coding-region start end cs)
89 (defsubst encode-mime-charset-string (string charset)
90 "Encode the STRING as MIME CHARSET."
92 (if (and enable-multibyte-characters
93 (setq cs (mime-charset-to-coding-system charset)))
94 (encode-coding-string string cs)
97 (defsubst decode-mime-charset-string (string charset &optional lbt)
98 "Decode the STRING as MIME CHARSET."
100 (if (and enable-multibyte-characters
101 (setq cs (mime-charset-to-coding-system charset lbt)))
102 (decode-coding-string string cs)
106 (defvar charsets-mime-charset-alist
107 '(((ascii) . us-ascii)
108 ((ascii latin-iso8859-1) . iso-8859-1)
109 ((ascii latin-iso8859-2) . iso-8859-2)
110 ((ascii latin-iso8859-3) . iso-8859-3)
111 ((ascii latin-iso8859-4) . iso-8859-4)
112 ;;; ((ascii cyrillic-iso8859-5) . iso-8859-5)
113 ((ascii cyrillic-iso8859-5) . koi8-r)
114 ((ascii arabic-iso8859-6) . iso-8859-6)
115 ((ascii greek-iso8859-7) . iso-8859-7)
116 ((ascii hebrew-iso8859-8) . iso-8859-8)
117 ((ascii latin-iso8859-9) . iso-8859-9)
118 ((ascii latin-jisx0201
119 japanese-jisx0208-1978 japanese-jisx0208) . iso-2022-jp)
120 ((ascii latin-jisx0201
121 katakana-jisx0201 japanese-jisx0208) . shift_jis)
122 ((ascii korean-ksc5601) . euc-kr)
123 ((ascii chinese-gb2312) . cn-gb-2312)
124 ((ascii chinese-big5-1 chinese-big5-2) . cn-big5)
125 ((ascii latin-iso8859-1 greek-iso8859-7
126 latin-jisx0201 japanese-jisx0208-1978
127 chinese-gb2312 japanese-jisx0208
128 korean-ksc5601 japanese-jisx0212) . iso-2022-jp-2)
129 ((ascii latin-iso8859-1 greek-iso8859-7
130 latin-jisx0201 japanese-jisx0208-1978
131 chinese-gb2312 japanese-jisx0208
132 korean-ksc5601 japanese-jisx0212
133 chinese-cns11643-1 chinese-cns11643-2) . iso-2022-int-1)
134 ((ascii latin-iso8859-1 latin-iso8859-2
135 cyrillic-iso8859-5 greek-iso8859-7
136 latin-jisx0201 japanese-jisx0208-1978
137 chinese-gb2312 japanese-jisx0208
138 korean-ksc5601 japanese-jisx0212
139 chinese-cns11643-1 chinese-cns11643-2
140 chinese-cns11643-3 chinese-cns11643-4
141 chinese-cns11643-5 chinese-cns11643-6
142 chinese-cns11643-7) . iso-2022-int-1)
149 ;;; @@ Mule emulating aliases
151 ;;; You should not use them.
153 (defun char-category (character)
154 "Return string of category mnemonics for CHAR in TABLE.
155 CHAR can be any multilingual character
156 TABLE defaults to the current buffer's category table."
157 (category-set-mnemonics (char-category-set character)))
162 (eval-when-compile (require 'ccl))
165 (defconst ccl-use-symbol-as-program
167 (define-ccl-program ew-ccl-identity-program
168 '(1 ((read r0) (loop (write-read-repeat r0)))))
172 (if (fboundp 'ccl-vector-program-execute-on-string)
173 'ccl-vector-program-execute-on-string
174 'ccl-execute-on-string)
175 'ew-ccl-identity-program
181 T if CCL related builtins accept symbol as CCL program.
182 (20.2 with ExCCL, 20.3 or later)
183 Otherwise nil (20.2 without ExCCL or former).
185 Because emu provides functions accepting symbol as CCL program,
186 user programs should not refer this variable.")
190 (defconst ccl-use-symbol-as-program
191 (eval-when-compile ccl-use-symbol-as-program))
193 (defun make-ccl-coding-system
194 (coding-system mnemonic doc-string decoder encoder)
196 Define a new CODING-SYSTEM (symbol) by CCL programs
197 DECODER (symbol) and ENCODER (symbol)."
198 (unless ccl-use-symbol-as-program
199 (setq decoder (symbol-value decoder))
200 (setq encoder (symbol-value encoder)))
201 (make-coding-system coding-system 4 mnemonic doc-string
202 (cons decoder encoder)))
206 (define-ccl-program test-ccl-eof-block
211 (unless (coding-system-p 'test-ccl-eof-block-cs)
212 (make-ccl-coding-system
213 'test-ccl-eof-block-cs ?T "CCL_EOF_BLOCK tester"
214 'test-ccl-eof-block 'test-ccl-eof-block)
218 (defconst ccl-encoder-eof-block-is-broken
220 (not (equal (encode-coding-string "" 'test-ccl-eof-block-cs)
222 "t if CCL_EOF_BLOCK is not executed when coding system encounts EOF on
225 (defconst ccl-decoder-eof-block-is-broken
227 (not (equal (decode-coding-string "" 'test-ccl-eof-block-cs)
229 "t if CCL_EOF_BLOCK is not executed when coding system encounts EOF on
232 (defconst ccl-eof-block-is-broken
233 (or ccl-encoder-eof-block-is-broken
234 ccl-decoder-eof-block-is-broken))
236 (unless ccl-use-symbol-as-program
238 (when (subrp (symbol-function 'ccl-execute))
239 (fset 'ccl-vector-program-execute
240 (symbol-function 'ccl-execute))
241 (defun ccl-execute (ccl-prog reg)
243 Execute CCL-PROG with registers initialized by REGISTERS.
244 If CCL-PROG is symbol, it is dereferenced.
245 \[Emacs 20.3 emulating function]"
246 (ccl-vector-program-execute
247 (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog)
250 (when (subrp (symbol-function 'ccl-execute-on-string))
251 (fset 'ccl-vector-program-execute-on-string
252 (symbol-function 'ccl-execute-on-string))
253 (defun ccl-execute-on-string (ccl-prog status string &optional contin)
255 Execute CCL-PROG with initial STATUS on STRING.
256 If CCL-PROG is symbol, it is dereferenced.
257 \[Emacs 20.3 emulating function]"
258 (ccl-vector-program-execute-on-string
259 (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog)
260 status string contin)))
269 (defalias 'insert-binary-file-contents 'insert-file-contents-as-binary)
270 (make-obsolete 'insert-binary-file-contents 'insert-file-contents-as-binary)
272 (defalias 'insert-binary-file-contents-literally
273 'insert-file-contents-literally)
275 (if (and (fboundp 'set-buffer-multibyte)
276 (subrp (symbol-function 'set-buffer-multibyte)))
277 (require 'emu-e20_3) ; for Emacs 20.3
278 (require 'emu-e20_2) ; for Emacs 20.1 and 20.2
284 ;;; emu-e20.el ends here