1 ;;; emu-nemacs.el --- Mule 2 emulation module for NEmacs
3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
7 ;; $Id: emu-nemacs.el,v 7.44 1996/09/18 13:40:26 morioka Exp $
8 ;; Keywords: emulation, compatibility, NEmacs, mule
10 ;; This file is part of tl (Tiny Library).
12 ;; This program is free software; you can redistribute it and/or
13 ;; modify it under the terms of the GNU General Public License as
14 ;; published by the Free Software Foundation; either version 2, or (at
15 ;; your option) any later version.
17 ;; This program is distributed in the hope that it will be useful, but
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with this program; see the file COPYING. If not, write to
24 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
35 (defconst charset-ascii 0 "Character set of ASCII")
36 (defconst charset-jisx0208 146 "Character set of JIS X0208-1983")
38 (defun charset-description (charset)
39 "Return description of CHARSET. [emu-nemacs.el]"
41 (documentation-property 'charset-ascii 'variable-documentation)
42 (documentation-property 'charset-jisx0208 'variable-documentation)
45 (defun charset-registry (charset)
46 "Return registry name of CHARSET. [emu-nemacs.el]"
51 (defun charset-columns (charset)
52 "Return number of columns a CHARSET occupies when displayed.
58 (defun charset-direction (charset)
59 "Return the direction of a character of CHARSET by
60 0 (left-to-right) or 1 (right-to-left). [emu-nemacs.el]"
63 (defun find-charset-string (str)
64 "Return a list of charsets in the string.
65 \[emu-nemacs.el; Mule emulating function]"
66 (if (string-match "[\200-\377]" str)
70 (defun find-charset-region (start end)
71 "Return a list of charsets in the region between START and END.
72 \[emu-nemacs.el; Mule emulating function]"
75 (narrow-to-region start end)
77 (re-search-forward "[\200-\377]" nil t)
82 (defun check-ASCII-string (str)
85 (setq len (length str))
88 (if (>= (elt str i) 128)
94 ;;; @@ for old MULE emulation
104 (defconst *noconv* 0)
108 (defconst *internal* 3)
109 (defconst *euc-japan* 3)
111 (defun decode-coding-string (string coding-system)
112 "Decode the STRING which is encoded in CODING-SYSTEM.
113 \[emu-nemacs.el; EMACS 20 emulating function]"
114 (if (eq coding-system 3)
116 (convert-string-kanji-code string coding-system 3)
119 (defun encode-coding-string (string coding-system)
120 "Encode the STRING to CODING-SYSTEM.
121 \[emu-nemacs.el; EMACS 20 emulating function]"
122 (if (eq coding-system 3)
124 (convert-string-kanji-code string 3 coding-system)
127 (defun decode-coding-region (start end coding-system)
128 "Decode the text between START and END which is encoded in CODING-SYSTEM.
129 \[emu-nemacs.el; EMACS 20 emulating function]"
133 (narrow-to-region start end)
134 (convert-region-kanji-code start end coding-system 3)
137 (defun encode-coding-region (start end coding-system)
138 "Encode the text between START and END to CODING-SYSTEM.
139 \[emu-nemacs.el; EMACS 20 emulating function]"
143 (narrow-to-region start end)
144 (convert-region-kanji-code start end 3 coding-system)
147 (defun code-detect-region (start end)
148 "Detect coding-system of the text in the region between START and END.
149 \[emu-nemacs.el; Mule emulating function]"
152 (narrow-to-region start end)
154 (re-search-forward "[\200-\377]" nil t)
159 (defun set-file-coding-system (coding-system &optional force)
160 (set-kanji-fileio-code coding-system)
163 (defmacro as-binary-process (&rest body)
164 (` (let (selective-display ; Disable ^M to nl translation.
167 (default-kanji-process-code 0)
168 program-kanji-code-alist)
172 (defmacro as-binary-input-file (&rest body)
177 ;;; @@ for old MULE emulation
180 (defun code-convert-string (str ic oc)
181 "Convert code in STRING from SOURCE code to TARGET code,
182 On successful converion, returns the result string,
183 else returns nil. [emu-nemacs.el; Mule emulating function]"
185 (convert-string-kanji-code str ic oc)
188 (defun code-convert-region (beg end ic oc)
189 "Convert code of the text between BEGIN and END from SOURCE
190 to TARGET. On successful conversion returns t,
191 else returns nil. [emu-nemacs.el; Mule emulating function]"
195 (narrow-to-region beg end)
196 (convert-region-kanji-code beg end ic oc)
203 (defvar charsets-mime-charset-alist
204 (list (cons (list charset-ascii) 'us-ascii)))
206 (defvar default-mime-charset 'iso-2022-jp)
208 (defvar mime-charset-coding-system-alist
213 (defun mime-charset-to-coding-system (charset)
214 (if (stringp charset)
215 (setq charset (intern (downcase charset)))
217 (cdr (assq charset mime-charset-coding-system-alist))
220 (defun detect-mime-charset-region (start end)
221 "Return MIME charset for region between START and END.
225 (narrow-to-region start end)
227 (re-search-forward "[\200-\377]" nil t)
232 (defun encode-mime-charset-region (start end charset)
233 "Encode the text between START and END as MIME CHARSET.
235 (let ((cs (mime-charset-to-coding-system charset)))
240 (narrow-to-region start end)
241 (convert-region-kanji-code start end 3 cs)
245 (defun decode-mime-charset-region (start end charset)
246 "Decode the text between START and END as MIME CHARSET.
248 (let ((cs (mime-charset-to-coding-system charset)))
253 (narrow-to-region start end)
254 (convert-region-kanji-code start end cs 3)
258 (defun encode-mime-charset-string (string charset)
259 "Encode the STRING as MIME CHARSET. [emu-nemacs.el]"
260 (let ((cs (mime-charset-to-coding-system charset)))
262 (convert-string-kanji-code string 3 cs)
265 (defun decode-mime-charset-string (string charset)
266 "Decode the STRING as MIME CHARSET. [emu-nemacs.el]"
267 (let ((cs (mime-charset-to-coding-system charset)))
269 (convert-string-kanji-code string cs 3)
276 (defun char-charset (chr)
277 "Return the character set of char CHR.
278 \[emu-nemacs.el; XEmacs 20 emulating function]"
283 (defun char-bytes (chr)
284 "Return number of bytes CHAR will occupy in a buffer.
285 \[emu-nemacs.el; Mule emulating function]"
286 (if (< chr 128) 1 2))
288 (defalias 'char-length 'char-bytes)
290 (defun char-columns (character)
291 "Return number of columns a CHARACTER occupies when displayed.
293 (if (< character 128)
297 ;;; @@ for Mule emulation
300 (defalias 'char-leading-char 'char-charset)
302 (defalias 'char-width 'char-columns)
308 (defalias 'string-columns 'length)
310 (defun sref (str idx)
311 "Return the character in STR at index IDX.
312 \[emu-nemacs.el; Mule emulating function]"
313 (let ((chr (aref str idx)))
316 (logior (lsh (aref str (1+ idx)) 8) chr)
319 (defun string-to-char-list (str)
320 (let ((i 0)(len (length str)) dest chr)
322 (setq chr (aref str i))
325 chr (+ (lsh chr 8) (aref str i))
327 (setq dest (cons chr dest))
333 (fset 'string-to-int-list (symbol-function 'string-to-char-list))
335 ;;; Imported from Mule-2.3
336 (defun truncate-string (str width &optional start-column)
337 "Truncate STR to fit in WIDTH columns.
338 Optional non-nil arg START-COLUMN specifies the starting column.
339 \[emu-mule.el; Mule 2.3 emulating function]"
341 (setq start-column 0))
342 (let ((max-width (string-width str))
347 (if (>= width max-width)
348 (setq width max-width))
349 (if (>= start-column width)
351 (while (< column start-column)
352 (setq ch (aref str from)
353 column (+ column (char-columns ch))
354 from (+ from (char-bytes ch))))
355 (if (< width max-width)
358 (while (<= column width)
359 (setq ch (aref str to)
360 column (+ column (char-columns ch))
362 to (+ to (char-bytes ch))))
364 (substring str from to))))
366 ;;; @@ for Mule emulation
369 (defalias 'string-width 'length)
372 ;;; @ text property emulation
375 (setq tl:available-face-attribute-alist
377 ;;(bold . inversed-region)
378 (italic . underlined-region)
379 (underline . underlined-region)
382 ;; by YAMATE Keiichirou 1994/10/28
383 (defun attribute-add-narrow-attribute (attr from to)
384 (or (consp (symbol-value attr))
386 (let* ((attr-value (symbol-value attr))
387 (len (car attr-value))
390 (while (and (< posfrom len)
391 (> from (nth posfrom attr-value)))
392 (setq posfrom (1+ posfrom)))
394 (while (and (< posto len)
395 (> to (nth posto attr-value)))
396 (setq posto (1+ posto)))
397 (if (= posto posfrom)
398 (if (= (% posto 2) 1)
400 (= to (nth posto attr-value)))
401 (set-marker (nth posto attr-value) from)
402 (setcdr (nthcdr (1- posfrom) attr-value)
403 (cons (set-marker-type (set-marker (make-marker)
406 (cons (set-marker-type (set-marker (make-marker)
409 (nthcdr posto attr-value))))
410 (setcar attr-value (+ len 2))))
411 (if (= (% posfrom 2) 0)
412 (setq posfrom (1- posfrom))
413 (set-marker (nth posfrom attr-value) from))
414 (if (= (% posto 2) 0)
416 (setq posto (1- posto))
417 (set-marker (nth posto attr-value) to))
418 (setcdr (nthcdr posfrom attr-value)
419 (nthcdr posto attr-value)))))
421 (defalias 'tl:make-overlay 'cons)
423 (defun tl:overlay-put (overlay prop value)
424 (let ((ret (and (eq prop 'face)
425 (assq value tl:available-face-attribute-alist)
428 (attribute-add-narrow-attribute (cdr ret)
429 (car overlay)(cdr overlay))
436 (provide 'emu-nemacs)
438 ;;; emu-nemacs.el ends here