tm 7.65.
[elisp/apel.git] / emu-nemacs.el
index 6b3fcfa..986c3b6 100644 (file)
@@ -2,48 +2,86 @@
 ;;; emu-nemacs.el --- Mule 2 emulation module for NEmacs
 ;;;
 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
-;;; Copyright (C) 1994,1995 MORIOKA Tomohiko
+;;; Copyright (C) 1993 .. 1996 MORIOKA Tomohiko
 ;;;
 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;; modified by KOBAYASHI Shuhei <shuhei-k@jaist.ac.jp>
 ;;; Version:
-;;;    $Id: emu-nemacs.el,v 7.0 1995/10/05 12:16:34 morioka Exp $
+;;;    $Id: emu-nemacs.el,v 7.27 1996/05/27 12:27:59 morioka Exp $
 ;;; Keywords: emulation, compatibility, NEmacs, Mule
 ;;;
-;;; This file is part of tl and tm (Tools for MIME).
+;;; 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:
 
 (require 'emu-18)
 
 
-;;; @ constants
+;;; @ character set
 ;;;
 
-(defconst emacs-major-version (string-to-int emacs-version))
+(defconst charset-ascii 0 "Character set of ASCII")
+(defconst charset-jisx0208 146 "Character set of JIS X0208-1983")
 
-
-;;; @ leading-char
+;;; @@ for Mule emulation
 ;;;
 
 (defconst lc-ascii 0)
 (defconst lc-jp  146)
 
-(defun char-leading-char (chr)
-  "Return leading character of CHAR.
-\[emu-nemacs.el; Mule emulating function]"
-  (if (< chr 128)
-      lc-ascii
-    lc-jp))
-
-(defalias 'get-lc 'char-leading-char)
-
 
-;;; @ coding-system
+;;; @ coding system
 ;;;
 
-(defconst *junet* 2)
-(defconst *internal* 3)
+(defconst *noconv*    0)
+(defconst *sjis*      1)
+(defconst *junet*     2)
+(defconst *ctext*     2)
+(defconst *internal*  3)
 (defconst *euc-japan* 3)
 
+(defun character-encode-string (str coding-system)
+  "Encode the string STR which is encoded in CODING-SYSTEM. [emu-nemacs.el]"
+  (convert-string-kanji-code str 3 coding-system)
+  )
+
+(defun character-decode-string (str coding-system)
+  "Decode the string STR which is encoded in CODING-SYSTEM. [emu-nemacs.el]"
+  (convert-string-kanji-code str coding-system 3)
+  )
+
+(defun character-encode-region (start end coding-system)
+  "Encode the text between START and END which is
+encoded in CODING-SYSTEM. [emu-nemacs.el]"
+  (save-excursion
+    (save-restriction
+      (narrow-to-region beg end)
+      (convert-region-kanji-code start end 3 coding-system)
+      )))
+
+(defun character-decode-region (start end coding-system)
+  "Decode the text between START and END which is
+encoded in CODING-SYSTEM. [emu-nemacs.el]"
+  (save-excursion
+    (save-restriction
+      (narrow-to-region beg end)
+      (convert-region-kanji-code start end coding-system 3)
+      )))
+
 (defun code-convert-string (str ic oc)
   "Convert code in STRING from SOURCE code to TARGET code,
 On successful converion, returns the result string,
@@ -52,25 +90,77 @@ else returns nil. [emu-nemacs.el; Mule emulating function]"
       (convert-string-kanji-code str ic oc)
     str))
 
+(defun code-convert-region (beg end ic oc)
+  "Convert code of the text between BEGIN and END from SOURCE
+to TARGET. On successful conversion returns t,
+else returns nil. [emu-nemacs.el; Mule emulating function]"
+  (if (/= ic oc)
+      (save-excursion
+       (save-restriction
+         (narrow-to-region beg end)
+         (convert-region-kanji-code beg end ic oc)
+         ))))
+
+(defun code-detect-region (start end)
+  "Detect coding-system of the text in the region between START and END.
+\[emu-nemacs.el; Mule emulating function]"
+  (if (save-excursion
+       (save-restriction
+         (narrow-to-region start end)
+         (goto-char start)
+         (re-search-forward "[\200-\377]" nil t)
+         ))
+      *euc-japan*
+    ))
+
+(defun set-file-coding-system (coding-system &optional force)
+  (set-kanji-fileio-code coding-system)
+  )
+
 
-;;; @ character and string
+;;; @ character
 ;;;
 
+(defun char-charset (chr)
+  "Return the character set of char CHR.
+\[emu-nemacs.el; XEmacs 20 emulating function]"
+  (if (< chr 128)
+      charset-ascii
+    charset-jisx0208))
+
 (defun char-bytes (chr)
   "Return number of bytes CHAR will occupy in a buffer.
- [Mule compatible function in tm-nemacs]"
+\[emu-nemacs.el; Mule emulating function]"
   (if (< chr 128) 1 2))
 
-(defun char-width (chr)
-  "Return number of columns CHAR will occupy when displayed.
- [Mule compatible function in tm-nemacs]"
-  (if (< chr 128) 1 2))
+(defun char-columns (character)
+  "Return number of columns a CHARACTER occupies when displayed.
+\[emu-nemacs.el]"
+  (if (< character 128)
+      1
+    2))
 
-;; by mol. 1993/9/26
-(defun string-width (str)
-  "Return number of columns STRING will occupy.
- [Mule compatible function in tm-nemacs]"
-  (length str))
+;;; @@ for Mule emulation
+;;;
+
+(defalias 'char-leading-char 'char-charset)
+
+(defalias 'char-width 'char-columns)
+
+
+;;; @ string
+;;;
+
+(defalias 'string-columns 'length)
+
+(defun sref (str idx)
+  "Return the character in STR at index IDX.
+\[emu-nemacs.el; Mule emulating function]"
+  (let ((chr (aref str idx)))
+    (if (< chr 128)
+       chr
+      (logior (lsh (aref str (1+ idx)) 8) chr)
+      )))
 
 (defun string-to-char-list (str)
   (let ((i 0)(len (length str)) dest chr)
@@ -86,6 +176,27 @@ else returns nil. [emu-nemacs.el; Mule emulating function]"
     (reverse dest)
     ))
 
+(fset 'string-to-int-list (symbol-function 'string-to-char-list))
+
+(defun find-charset-string (str)
+  "Return a list of leading-chars in the string.
+\[emu-nemacs.el; Mule emulating function]"
+  (if (string-match "[\200-\377]" str)
+      (list lc-jp)
+    ))
+
+(defun find-charset-region (start end)
+  "Return a list of leading-chars in the region between START and END.
+\[emu-nemacs.el; Mule emulating function]"
+  (if (save-excursion
+       (save-restriction
+         (narrow-to-region start end)
+         (goto-char start)
+         (re-search-forward "[\200-\377]" nil t)
+         ))
+      (list lc-jp)
+    ))
+
 (defun check-ASCII-string (str)
   (let ((i 0)
        len)
@@ -98,6 +209,42 @@ else returns nil. [emu-nemacs.el; Mule emulating function]"
        )
       str)))
 
+;;; Imported from Mule-2.3
+(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-mule.el; Mule 2.3 emulating function]"
+  (or start-column
+      (setq start-column 0))
+  (let ((max-width (string-width str))
+       (len (length str))
+       (from 0)
+       (column 0)
+       to-prev to ch)
+    (if (>= width max-width)
+       (setq width max-width))
+    (if (>= start-column width)
+       ""
+      (while (< column start-column)
+       (setq ch (aref str from)
+             column (+ column (char-columns ch))
+             from (+ from (char-bytes ch))))
+      (if (< width max-width)
+         (progn
+           (setq to from)
+           (while (<= column width)
+             (setq ch (aref str to)
+                   column (+ column (char-columns ch))
+                   to-prev to
+                   to (+ to (char-bytes ch))))
+           (setq to to-prev)))
+      (substring str from to))))
+
+;;; @@ for Mule emulation
+;;;
+
+(defalias 'string-width 'length)
+
 
 ;;; @ text property emulation
 ;;;
@@ -159,10 +306,10 @@ else returns nil. [emu-nemacs.el; Mule emulating function]"
                                        (car overlay)(cdr overlay))
       )))
 
-(defun tl:add-text-properties (start end properties &optional object)) 
-
 
 ;;; @ end
 ;;;
 
 (provide 'emu-nemacs)
+
+;;; emu-nemacs.el ends here