X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=emu-x20.el;h=32a06188650ff6272e9b09f9bbcf41255c3201a4;hb=c1678c187d1a8796b1aa819a118f6024476b4a26;hp=4b6b9692194ec3db355467cb3a2075735d288512;hpb=74116756c558cf006fa942fff1f5da0dce6c597b;p=elisp%2Fapel.git diff --git a/emu-x20.el b/emu-x20.el index 4b6b969..32a0618 100644 --- a/emu-x20.el +++ b/emu-x20.el @@ -1,158 +1,172 @@ -;;; -;;; emu-x20.el --- Mule 2 emulation module for XEmacs 20 with Mule -;;; -;;; Copyright (C) 1995 Free Software Foundation, Inc. -;;; Copyright (C) 1994 .. 1996 MORIOKA Tomohiko -;;; -;;; Author: MORIOKA Tomohiko -;;; Version: -;;; $Id: emu-x20.el,v 7.0 1996/05/09 13:48:25 morioka Exp $ -;;; Keywords: emulation, compatibility, Mule, XEmacs -;;; -;;; This file is part of tl (Tiny Library). -;;; -;;; This program is free software; you can redistribute it and/or -;;; modify it under the terms of the GNU General Public License as -;;; published by the Free Software Foundation; either version 2, or -;;; (at your option) any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with This program. If not, write to the Free Software -;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;; -;;; Code: +;;; emu-x20.el --- emu API implementation for XEmacs with mule -(defvar xemacs-beta-version - (if (string-match "(beta\\([0-9]+\\))" emacs-version) - (string-to-number - (substring emacs-version (match-beginning 1)(match-end 1)) - ))) +;; Copyright (C) 1994,1995,1996,1997,1998 MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko +;; Keywords: emulation, compatibility, Mule, XEmacs -;;; @ character set -;;; +;; This file is part of emu. -(defalias 'char-leading-char 'char-charset) +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. -(defun find-charset-string (string) - "Return a list of charsets in the STRING except ascii. -\[emu-x20.el; Mule emulating function]" - (delq 'ascii (charsets-in-string string)) - ) +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. -(defun find-charset-region (start end) - "Return a list of charsets except ascii -in the region between START and END. -\[emu-x20.el; Mule emulating function]" - (delq 'ascii (charsets-in-region start end)) - ) +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. -(defconst lc-ascii 'ascii) -(defconst lc-ltn1 'latin-1) -(defconst lc-ltn2 'latin-2) -(defconst lc-ltn3 'latin-3) -(defconst lc-ltn4 'latin-4) -(defconst lc-crl 'cyrillic) -(defconst lc-arb 'arabic) -(defconst lc-grk 'greek) -(defconst lc-hbw 'hebrew) -(defconst lc-ltn5 'latin-5) -(defconst lc-jp 'japanese) -(defconst lc-jp2 'japanese-2) -(defconst lc-kr 'korean) -(defconst lc-big5-1 'chinese-big5-1) -(defconst lc-big5-2 'chinese-big5-2) -(defconst lc-cn 'chinese-gb) -(defconst lc-cns1 'chinese-cns-1) -(defconst lc-cns2 'chinese-cns-2) -(defconst lc-cns3 'chinese-cns-3) -(defconst lc-cns4 'chinese-cns-4) -(defconst lc-cns5 'chinese-cns-5) -(defconst lc-cns6 'chinese-cns-6) -(defconst lc-cns7 'chinese-cns-7) - - -;;; @ coding-system -;;; +;;; Commentary: -(defconst *noconv* 'noconv) -(defconst *ctext* 'ctext) -(defconst *hz* 'hz) -(defconst *big5* 'big5) -(defconst *euc-kr* 'euc-kr) -(defconst *koi8* nil) +;; This module requires XEmacs 20.3-b5 or later with mule. -(defvar code-converter-is-broken - (and xemacs-beta-version (<= xemacs-beta-version 18))) +;;; Code: -(if code-converter-is-broken -(progn -;;; -(defun decode-coding-region (start end coding-system &optional buffer) - "Decode the text between START and END which is encoded in CODING-SYSTEM. -\[emu-x20.el; XEmacs 20 emulating function]" - (save-excursion - (if buffer - (set-buffer buffer) - ) - (save-restriction - (narrow-to-region start end) - (let ((process-output-coding-system 'noconv) - (process-input-coding-system coding-system)) - (call-process-region start end "cat" t t nil) - )))) - -(defun encode-coding-region (start end coding-system &optional buffer) - "Encode the text between START and END which is encoded in CODING-SYSTEM. -\[emu-x20.el; XEmacs 20 emulating function]" - (save-excursion - (if buffer - (set-buffer buffer) - ) - (save-restriction - (narrow-to-region start end) - (let ((process-output-coding-system coding-system) - (process-input-coding-system 'noconv)) - (call-process-region start end "cat" t t nil) - )))) -;;; -)) +(require 'emu-xemacs) +(require 'emu-20) -(defalias 'character-encode-string 'encode-coding-string) -(defalias 'character-decode-string 'decode-coding-string) -(defalias 'character-encode-region 'encode-coding-region) -(defalias 'character-decode-region 'decode-coding-region) +(and (coding-system-property 'iso-2022-jp 'input-charset-conversion) + (copy-coding-system 'iso-2022-7bit 'iso-2022-jp)) -;;; @ character and string + +;;; @ binary access ;;; -(defun char-bytes (chr) 1) -(defun char-width (chr) 1) +(defun insert-file-contents-as-binary (filename + &optional visit beg end replace) + "Like `insert-file-contents', q.v., but don't code and format conversion. +Like `insert-file-contents-literary', but it allows find-file-hooks, +automatic uncompression, etc. + +Namely this function ensures that only format decoding and character +code conversion will not take place." + (let ((coding-system-for-read 'binary) + format-alist) + (insert-file-contents filename visit beg end replace) + )) + +(define-obsolete-function-alias 'insert-binary-file-contents + 'insert-file-contents-as-binary) + +(defun insert-binary-file-contents-literally (filename + &optional visit beg end replace) + "Like `insert-file-contents-literally', q.v., but don't code conversion. +A buffer may be modified in several ways after reading into the buffer due +to advanced Emacs features, such as file-name-handlers, format decoding, +find-file-hooks, etc. + This function ensures that none of these modifications will take place." + (let ((coding-system-for-read 'binary)) + (insert-file-contents-literally filename visit beg end replace) + )) + + +;;; @ MIME charset +;;; -(defalias 'string-width 'length) +(defsubst encode-mime-charset-region (start end charset) + "Encode the text between START and END as MIME CHARSET." + (let ((cs (mime-charset-to-coding-system charset))) + (if cs + (encode-coding-region start end cs) + ))) + +(defsubst decode-mime-charset-region (start end charset) + "Decode the text between START and END as MIME CHARSET." + (let ((cs (mime-charset-to-coding-system charset))) + (if cs + (decode-coding-region start end cs) + ))) + +(defsubst encode-mime-charset-string (string charset) + "Encode the STRING as MIME CHARSET." + (let ((cs (mime-charset-to-coding-system charset))) + (if cs + (encode-coding-string string cs) + string))) + +(defsubst decode-mime-charset-string (string charset) + "Decode the STRING as MIME CHARSET." + (let ((cs (mime-charset-to-coding-system charset))) + (if cs + (decode-coding-string string cs) + string))) + + +(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 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) + )) + +(defun detect-mime-charset-region (start end) + "Return MIME charset for region between START and END." + (charsets-to-mime-charset (charsets-in-region start end))) + + +;;; @ character +;;; -(defalias 'sref 'aref) +;;; @@ Mule emulating aliases +;;; +;;; You should not use them. -(defun truncate-string (str width &optional start-column) - "Truncate STR to fit in WIDTH columns. -Optional non-nil arg START-COLUMN specifies the starting column. -\[emu-x20.el; Mule 2.3 emulating function]" - (or start-column - (setq start-column 0)) - (substring str start-column width) - ) +(defalias 'char-leading-char 'char-charset) +(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." + (mapconcat (lambda (chr) + (char-to-string (int-char chr)) + ) + (char-category-list character) + "")) -;;; @ etc + +;;; @ string ;;; -(require 'emu-xemacs) +(defun string-to-int-list (str) + (mapcar #'char-int str) + ) ;;; @ end