2 ;;; emu-nemacs.el --- Mule 2 emulation module for NEmacs
4 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
5 ;;; Copyright (C) 1994 .. 1996 MORIOKA Tomohiko
7 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
8 ;;; modified by KOBAYASHI Shuhei <shuhei@cmpt01.phys.tohoku.ac.jp>
10 ;;; $Id: emu-nemacs.el,v 7.4 1996/01/25 02:11:31 morioka Exp $
11 ;;; Keywords: emulation, compatibility, NEmacs, Mule
13 ;;; This file is part of tl (Tiny Library).
15 ;;; This program is free software; you can redistribute it and/or
16 ;;; modify it under the terms of the GNU General Public License as
17 ;;; published by the Free Software Foundation; either version 2, or
18 ;;; (at your option) any later version.
20 ;;; This program is distributed in the hope that it will be useful,
21 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
23 ;;; General Public License for more details.
25 ;;; You should have received a copy of the GNU General Public License
26 ;;; along with This program. If not, write to the Free Software
27 ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
37 (defconst emacs-major-version (string-to-int emacs-version))
46 (defun char-leading-char (chr)
47 "Return leading character of CHAR.
48 \[emu-nemacs.el; Mule emulating function]"
53 (defalias 'get-lc 'char-leading-char)
61 (defconst *internal* 3)
62 (defconst *euc-japan* 3)
64 (defun code-convert-string (str ic oc)
65 "Convert code in STRING from SOURCE code to TARGET code,
66 On successful converion, returns the result string,
67 else returns nil. [emu-nemacs.el; Mule emulating function]"
69 (convert-string-kanji-code str ic oc)
72 (defun code-convert-region (beg end ic oc)
73 "Convert code of the text between BEGIN and END from SOURCE
74 to TARGET. On successful conversion returns t,
75 else returns nil. [emu-nemacs.el; Mule emulating function]"
77 (convert-region-kanji-code beg end ic oc)))
80 ;;; @ character and string
83 (defun char-bytes (chr)
84 "Return number of bytes CHAR will occupy in a buffer.
85 [Mule compatible function in tm-nemacs]"
88 (defun char-width (chr)
89 "Return number of columns CHAR will occupy when displayed.
90 [Mule compatible function in tm-nemacs]"
94 (defun string-width (str)
95 "Return number of columns STRING will occupy.
96 [Mule compatible function in tm-nemacs]"
99 (defun string-to-char-list (str)
100 (let ((i 0)(len (length str)) dest chr)
102 (setq chr (aref str i))
105 chr (+ (lsh chr 8) (aref str i))
107 (setq dest (cons chr dest))
113 (defun find-charset-string (str)
114 (if (string-match "[\200-\377]" str)
118 (defun find-charset-region (start end)
121 (narrow-to-region start end)
123 (re-search-forward "[\200-\377]" nil t)
128 (defun check-ASCII-string (str)
131 (setq len (length str))
134 (if (>= (elt str i) 128)
141 ;;; @ text property emulation
144 (setq tl:available-face-attribute-alist
146 ;;(bold . inversed-region)
147 (italic . underlined-region)
148 (underline . underlined-region)
151 ;; by YAMATE Keiichirou 1994/10/28
152 (defun attribute-add-narrow-attribute (attr from to)
153 (or (consp (symbol-value attr))
155 (let* ((attr-value (symbol-value attr))
156 (len (car attr-value))
159 (while (and (< posfrom len)
160 (> from (nth posfrom attr-value)))
161 (setq posfrom (1+ posfrom)))
163 (while (and (< posto len)
164 (> to (nth posto attr-value)))
165 (setq posto (1+ posto)))
166 (if (= posto posfrom)
167 (if (= (% posto 2) 1)
169 (= to (nth posto attr-value)))
170 (set-marker (nth posto attr-value) from)
171 (setcdr (nthcdr (1- posfrom) attr-value)
172 (cons (set-marker-type (set-marker (make-marker)
175 (cons (set-marker-type (set-marker (make-marker)
178 (nthcdr posto attr-value))))
179 (setcar attr-value (+ len 2))))
180 (if (= (% posfrom 2) 0)
181 (setq posfrom (1- posfrom))
182 (set-marker (nth posfrom attr-value) from))
183 (if (= (% posto 2) 0)
185 (setq posto (1- posto))
186 (set-marker (nth posto attr-value) to))
187 (setcdr (nthcdr posfrom attr-value)
188 (nthcdr posto attr-value)))))
190 (defalias 'tl:make-overlay 'cons)
192 (defun tl:overlay-put (overlay prop value)
193 (let ((ret (and (eq prop 'face)
194 (assq value tl:available-face-attribute-alist)
197 (attribute-add-narrow-attribute (cdr ret)
198 (car overlay)(cdr overlay))
201 (defun tl:add-text-properties (start end properties &optional object))
207 (provide 'emu-nemacs)
209 ;;; emu-nemacs.el ends here