X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=emu-e20.el;h=cf8d805cf75a9f0c4a085767adef6629c06d63b8;hb=040b816908ef293e567cf66347afbd827fdba5a2;hp=e5623a15ad5431eb45b306b5cdcce59a713a1460;hpb=ef09d0e316472a2b608c82785d1b66db50582184;p=elisp%2Fapel.git diff --git a/emu-e20.el b/emu-e20.el index e5623a1..cf8d805 100644 --- a/emu-e20.el +++ b/emu-e20.el @@ -1,9 +1,8 @@ -;;; emu-e20.el --- emu API implementation for Emacs/mule (delta) +;;; emu-e20.el --- emu API implementation for Emacs 20.1 and 20.2 -;; Copyright (C) 1996 Free Software Foundation, Inc. +;; Copyright (C) 1996,1997,1998 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko -;; Version: $Id: emu-e20.el,v 7.2 1996/12/18 13:12:15 morioka Exp $ ;; Keywords: emulation, compatibility, Mule ;; This file is part of emu. @@ -23,69 +22,52 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;; Code: +;;; Commentary: -;;; @ version specific features -;;; +;; This module requires Emacs 20.1 and 20.2. + +;;; Code: -(require 'emu-19) +(require 'emu-e19) (defun fontset-pixel-size (fontset) - (require 'cl) (let* ((info (fontset-info fontset)) (height (aref info 1)) ) - (if (> height 0) - height - (let ((str (car (find-if (function identity) (aref info 2))))) - (if (string-match "--\\([0-9]+\\)-\\*-\\*-\\*-\\*-\\*-ISO8859-1" str) - (string-to-number - (substring str (match-beginning 1)(match-end 1)) - ) - 0))))) + (cond ((> height 0) height) + ((string-match "-\\([0-9]+\\)-" fontset) + (string-to-number + (substring fontset (match-beginning 1)(match-end 1)) + ) + ) + (t 0) + ))) ;;; @ character set ;;; -(defalias 'charset-columns 'charset-width) - -(defun charset-iso-class (charset) - "Return ISO-class of CHARSET. -\(0/CLASS94, 1/CLASS96, 2/CLASS94x94, 3/CLASS96x96) [emu-e20.el]" - (aref (charset-info charset) 5) - ) +;; (defalias 'charset-columns 'charset-width) (defun find-non-ascii-charset-string (string) - "Return a list of charsets in the STRING except ascii. -\[emu-e20.el; Mule emulating function]" - (delq charset-ascii (find-charset-string string)) + "Return a list of charsets in the STRING except ascii." + (delq 'ascii (find-charset-string string)) ) (defun find-non-ascii-charset-region (start end) "Return a list of charsets except ascii -in the region between START and END. -\[emu-e20.el; Mule emulating function]" - (delq charset-ascii (find-charset-string (buffer-substring start end))) +in the region between START and END." + (delq 'ascii (find-charset-string (buffer-substring start end))) ) ;;; @ coding system ;;; -(defconst *noconv* 'no-conversion) - -(defmacro as-binary-process (&rest body) - `(let (selective-display ; Disable ^M to nl translation. - ;; for Emacs/mule - (coding-system-for-read 'no-conversion) - (coding-system-for-write 'no-conversion) - ) - ,@ body)) - -(defmacro as-binary-input-file (&rest body) - `(let ((coding-system-for-read 'no-conversion)) - ,@body)) +(defsubst-maybe find-coding-system (obj) + "Return OBJ if it is a coding-system." + (if (coding-system-p obj) + obj)) (defalias 'set-process-input-coding-system 'set-process-coding-system) @@ -93,206 +75,204 @@ in the region between START and END. ;;; @ MIME charset ;;; -(defvar charsets-mime-charset-alist - (list - (cons (list charset-ascii) 'us-ascii) - (cons (list charset-ascii charset-latin-iso8859-1) 'iso-8859-1) - (cons (list charset-ascii charset-latin-iso8859-2) 'iso-8859-2) - (cons (list charset-ascii charset-latin-iso8859-3) 'iso-8859-3) - (cons (list charset-ascii charset-latin-iso8859-4) 'iso-8859-4) -;;;(cons (list charset-ascii -;;; charset-cyrillic-iso8859-5) 'iso-8859-5) - (cons (list charset-ascii - charset-cyrillic-iso8859-5) 'koi8-r) - (cons (list charset-ascii charset-arabic-iso8859-6) 'iso-8859-6) - (cons (list charset-ascii charset-greek-iso8859-7) 'iso-8859-7) - (cons (list charset-ascii charset-hebrew-iso8859-8) 'iso-8859-8) - (cons (list charset-ascii charset-latin-iso8859-9) 'iso-8859-9) - (cons (list charset-ascii - charset-latin-jisx0201 - charset-japanese-jisx0208-1978 - charset-japanese-jisx0208) 'iso-2022-jp) - (cons (list charset-ascii charset-korean-ksc5601) 'euc-kr) - (cons (list charset-ascii charset-chinese-gb2312) 'cn-gb-2312) - (cons (list charset-ascii - charset-chinese-big5-1 - charset-chinese-big5-2) 'cn-big5) - (cons (list charset-ascii charset-latin-iso8859-1 - charset-greek-iso8859-7 - charset-latin-jisx0201 - charset-japanese-jisx0208-1978 - charset-chinese-gb2312 - charset-japanese-jisx0208 - charset-korean-ksc5601 - charset-japanese-jisx0212) 'iso-2022-jp-2) - (cons (list charset-ascii charset-latin-iso8859-1 - charset-greek-iso8859-7 - charset-latin-jisx0201 - charset-japanese-jisx0208-1978 - charset-chinese-gb2312 - charset-japanese-jisx0208 - charset-korean-ksc5601 - charset-japanese-jisx0212 - charset-chinese-cns11643-1 - charset-chinese-cns11643-2) 'iso-2022-int-1) - (cons (list charset-ascii charset-latin-iso8859-1 - charset-latin-iso8859-2 - charset-cyrillic-iso8859-5 - charset-greek-iso8859-7 - charset-latin-jisx0201 - charset-japanese-jisx0208-1978 - charset-chinese-gb2312 - charset-japanese-jisx0208 - charset-korean-ksc5601 - charset-japanese-jisx0212 - charset-chinese-cns11643-1 - charset-chinese-cns11643-2 - charset-chinese-cns11643-3 - charset-chinese-cns11643-4 - charset-chinese-cns11643-5 - charset-chinese-cns11643-6 - charset-chinese-cns11643-7) 'iso-2022-int-1) - )) - -(defvar default-mime-charset 'x-ctext) - -(defvar mime-charset-coding-system-alist - '((x-ctext . coding-system-ctext) - (hz-gb-2312 . coding-system-hz) - (cn-gb-2312 . coding-system-euc-china) - (gb2312 . coding-system-euc-china) - (cn-big5 . coding-system-big5) - (iso-2022-jp-2 . coding-system-iso-2022-ss2-7) - (iso-2022-int-1 . coding-system-iso-2022-int) - (shift_jis . coding-system-sjis) - )) - -(defun mime-charset-to-coding-system (charset &optional lbt) - (if (stringp charset) - (setq charset (intern (downcase charset))) - ) - (let ((cs - (or (cdr (assq charset mime-charset-coding-system-alist)) - (let ((cs (intern (concat "coding-system-" - (symbol-name charset))))) - (and (coding-system-p cs) cs) - )))) - (if lbt - (intern (concat (symbol-name cs) "-" (symbol-name lbt))) - cs))) - -(defun detect-mime-charset-region (start end) - "Return MIME charset for region between START and END. [emu-e20.el]" - (charsets-to-mime-charset - (find-charset-string (buffer-substring start end)) - )) - -(defun encode-mime-charset-region (start end charset) - "Encode the text between START and END as MIME CHARSET. [emu-e20.el]" - (let ((cs (mime-charset-to-coding-system charset))) - (if cs +(defsubst encode-mime-charset-region (start end charset) + "Encode the text between START and END as MIME CHARSET." + (let (cs) + (if (and enable-multibyte-characters + (setq cs (mime-charset-to-coding-system charset))) (encode-coding-region start end cs) ))) -(defun decode-mime-charset-region (start end charset) - "Decode the text between START and END as MIME CHARSET. [emu-e20.el]" - (let ((cs (mime-charset-to-coding-system charset))) - (if cs +(defsubst decode-mime-charset-region (start end charset &optional lbt) + "Decode the text between START and END as MIME CHARSET." + (let (cs) + (if (and enable-multibyte-characters + (setq cs (mime-charset-to-coding-system charset lbt))) (decode-coding-region start end cs) ))) -(defun encode-mime-charset-string (string charset) - "Encode the STRING as MIME CHARSET. [emu-e20.el]" - (let ((cs (mime-charset-to-coding-system charset))) - (if cs +(defsubst encode-mime-charset-string (string charset) + "Encode the STRING as MIME CHARSET." + (let (cs) + (if (and enable-multibyte-characters + (setq cs (mime-charset-to-coding-system charset))) (encode-coding-string string cs) string))) -(defun decode-mime-charset-string (string charset) - "Decode the STRING as MIME CHARSET. [emu-e20.el]" - (let ((cs (mime-charset-to-coding-system charset))) - (if cs +(defsubst decode-mime-charset-string (string charset &optional lbt) + "Decode the STRING as MIME CHARSET." + (let (cs) + (if (and enable-multibyte-characters + (setq cs (mime-charset-to-coding-system charset lbt))) (decode-coding-string string cs) string))) -;;; @ character -;;; - -(defalias 'char-length 'char-bytes) +(defvar charsets-mime-charset-alist + '(((ascii) . us-ascii) + ((ascii latin-iso8859-1) . iso-8859-1) + ((ascii latin-iso8859-2) . iso-8859-2) + ((ascii latin-iso8859-3) . iso-8859-3) + ((ascii latin-iso8859-4) . iso-8859-4) +;;; ((ascii cyrillic-iso8859-5) . iso-8859-5) + ((ascii cyrillic-iso8859-5) . koi8-r) + ((ascii arabic-iso8859-6) . iso-8859-6) + ((ascii greek-iso8859-7) . iso-8859-7) + ((ascii hebrew-iso8859-8) . iso-8859-8) + ((ascii latin-iso8859-9) . iso-8859-9) + ((ascii latin-jisx0201 + japanese-jisx0208-1978 japanese-jisx0208) . iso-2022-jp) + ((ascii latin-jisx0201 + katakana-jisx0201 japanese-jisx0208) . shift_jis) + ((ascii korean-ksc5601) . euc-kr) + ((ascii chinese-gb2312) . cn-gb-2312) + ((ascii chinese-big5-1 chinese-big5-2) . cn-big5) + ((ascii latin-iso8859-1 greek-iso8859-7 + latin-jisx0201 japanese-jisx0208-1978 + chinese-gb2312 japanese-jisx0208 + korean-ksc5601 japanese-jisx0212) . iso-2022-jp-2) + ((ascii latin-iso8859-1 greek-iso8859-7 + latin-jisx0201 japanese-jisx0208-1978 + chinese-gb2312 japanese-jisx0208 + korean-ksc5601 japanese-jisx0212 + chinese-cns11643-1 chinese-cns11643-2) . iso-2022-int-1) + ((ascii latin-iso8859-1 latin-iso8859-2 + cyrillic-iso8859-5 greek-iso8859-7 + latin-jisx0201 japanese-jisx0208-1978 + chinese-gb2312 japanese-jisx0208 + korean-ksc5601 japanese-jisx0212 + chinese-cns11643-1 chinese-cns11643-2 + chinese-cns11643-3 chinese-cns11643-4 + chinese-cns11643-5 chinese-cns11643-6 + chinese-cns11643-7) . iso-2022-int-1) + )) -(defalias 'char-columns 'char-width) +;;; @ character +;;; ;;; @@ Mule emulating aliases ;;; ;;; You should not use them. -(defalias 'make-character 'make-char) - (defun char-category (character) "Return string of category mnemonics for CHAR in TABLE. CHAR can be any multilingual character -TABLE defaults to the current buffer's category table. -\[emu-e20.el; Mule emulating function]" +TABLE defaults to the current buffer's category table." (category-set-mnemonics (char-category-set character)) ) -;;; @ string +;;; @ CCL ;;; -(defalias 'string-columns 'string-width) - -(defalias 'sset 'string-embed-string) - -(defun string-to-char-list (string) - "Return a list of which elements are characters in the STRING. -\[emu-e20.el; Mule 2.3 emulating function]" - (let* ((len (length string)) - (i 0) - l chr) - (while (< i len) - (setq chr (sref string i)) - (setq l (cons chr l)) - (setq i (+ i (char-bytes chr))) - ) - (nreverse l) - )) - -(defalias 'string-to-int-list 'string-to-char-list) +(eval-and-compile +(defconst ccl-use-symbol-as-program + (eval-when-compile + (define-ccl-program ew-ccl-identity-program + '(1 ((read r0) (loop (write-read-repeat r0))))) + (condition-case nil + (progn + (make-coding-system + 'ew-ccl-identity 4 ?I + "Identity coding system for byte-compile time checking" + '(ew-ccl-identity-program . ew-ccl-identity-program)) + t) + (error nil))) + "t if CCL related builtins accept symbol as CCL +program. (20.2 with ExCCL, 20.3 or later) +Otherwise nil (20.2 without ExCCL or former). + +Because emu provides functions accepting symbol as CCL program, +user programs should not refer this variable.") + +(defun make-ccl-coding-system + (coding-system mnemonic doc-string decoder encoder) + "Define a new CODING-SYSTEM (symbol) by CCL programs +DECODER (symbol) and ENCODER (symbol)." + (unless ccl-use-symbol-as-program + (setq decoder (symbol-value decoder)) + (setq encoder (symbol-value encoder))) + (make-coding-system coding-system 4 mnemonic doc-string + (cons decoder encoder))) +) + +(eval-when-compile +(define-ccl-program test-ccl-eof-block + '(1 + (read r0) + (write "[EOF]"))) + +(unless (coding-system-p 'test-ccl-eof-block-cs) + (make-ccl-coding-system 'test-ccl-eof-block-cs ?T + "CCL_EOF_BLOCK tester" + 'test-ccl-eof-block + 'test-ccl-eof-block)) +) + +(defconst ccl-encoder-eof-block-is-broken + (eval-when-compile + (not (equal (encode-coding-string "" 'test-ccl-eof-block-cs) + "[EOF]"))) + "t if CCL_EOF_BLOCK is not executed when coding system encounts EOF on +encoding.") + +(defconst ccl-decoder-eof-block-is-broken + (eval-when-compile + (not (equal (decode-coding-string "" 'test-ccl-eof-block-cs) + "[EOF]"))) + "t if CCL_EOF_BLOCK is not executed when coding system encounts EOF on +decoding.") + +(defconst ccl-eof-block-is-broken + (or ccl-encoder-eof-block-is-broken + ccl-decoder-eof-block-is-broken)) + +(unless ccl-use-symbol-as-program + +(when (subrp (symbol-function 'ccl-execute)) + (fset 'ccl-vector-program-execute + (symbol-function 'ccl-execute)) + (defun ccl-execute (ccl-prog reg) + "Execute CCL-PROG `ccl-vector-program-execute'. +If CCL-PROG is symbol, it is dereferenced. +\[Emacs 20.3 emulating function]" + (ccl-vector-program-execute + (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog) + reg))) + +(when (subrp (symbol-function 'ccl-execute-on-string)) + (fset 'ccl-vector-program-execute-on-string + (symbol-function 'ccl-execute-on-string)) + (defun ccl-execute-on-string (ccl-prog status &optional contin) + "Execute CCL-PROG `ccl-vector-program-execute-on-string'. +If CCL-PROG is symbol, it is dereferenced. +\[Emacs 20.3 emulating function]" + (ccl-vector-program-execute-on-string + (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog) + status + contin))) + +) -;;; @ regulation +;;; @ end ;;; -(defun regulate-latin-char (chr) - (cond ((and (<= ?Ａ chr)(<= chr ?Ｚ)) - (+ (- chr ?Ａ) ?A) - ) - ((and (<= ?ａ chr)(<= chr ?ｚ)) - (+ (- chr ?ａ) ?a) - ) - ((eq chr ?．) ?.) - ((eq chr ?，) ?,) - (t chr) - )) - -(defun regulate-latin-string (str) - (let ((len (length str)) - (i 0) - chr (dest "")) - (while (< i len) - (setq chr (sref str i)) - (setq dest (concat dest - (char-to-string (regulate-latin-char chr)))) - (setq i (+ i (char-bytes chr))) - ) - dest)) +(require 'emu-20) +(defalias 'insert-binary-file-contents 'insert-file-contents-as-binary) +(make-obsolete 'insert-binary-file-contents 'insert-file-contents-as-binary) + +(defalias 'insert-binary-file-contents-literally + 'insert-file-contents-literally) + +(if (and (fboundp 'set-buffer-multibyte) + (subrp (symbol-function 'set-buffer-multibyte))) + (require 'emu-e20_3) ; for Emacs 20.3 + (require 'emu-e20_2) ; for Emacs 20.1 and 20.2 + ) -;;; @ end -;;; (provide 'emu-e20)