1 ;;; emu-nemacs.el --- emu API implementation for NEmacs
3 ;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; Keywords: emulation, compatibility, NEmacs, mule
8 ;; This file is part of emu.
10 ;; This program is free software; you can redistribute it and/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation; either version 2, or (at
13 ;; your option) any later version.
15 ;; This program is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
33 (defconst charset-ascii 0 "Character set of ASCII")
34 (defconst charset-jisx0208 146 "Character set of JIS X0208-1983")
36 (defun charset-description (charset)
37 "Return description of CHARSET. [emu-nemacs.el]"
39 (documentation-property 'charset-ascii 'variable-documentation)
40 (documentation-property 'charset-jisx0208 'variable-documentation)
43 (defun charset-registry (charset)
44 "Return registry name of CHARSET. [emu-nemacs.el]"
49 (defun charset-columns (charset)
50 "Return number of columns a CHARSET occupies when displayed.
56 (defun charset-direction (charset)
57 "Return the direction of a character of CHARSET by
58 0 (left-to-right) or 1 (right-to-left). [emu-nemacs.el]"
61 (defun find-charset-string (str)
62 "Return a list of charsets in the string.
63 \[emu-nemacs.el; Mule emulating function]"
64 (if (string-match "[\200-\377]" str)
68 (defalias 'find-non-ascii-charset-string 'find-charset-string)
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 (defalias 'find-non-ascii-charset-region 'find-charset-region)
84 (defun check-ASCII-string (str)
87 (setq len (length str))
90 (if (>= (elt str i) 128)
96 ;;; @@ for old MULE emulation
106 (defconst *noconv* 0)
110 (defconst *internal* 3)
111 (defconst *euc-japan* 3)
113 (defun decode-coding-string (string coding-system)
114 "Decode the STRING which is encoded in CODING-SYSTEM.
115 \[emu-nemacs.el; EMACS 20 emulating function]"
116 (if (eq coding-system 3)
118 (convert-string-kanji-code string coding-system 3)
121 (defun encode-coding-string (string coding-system)
122 "Encode the STRING to CODING-SYSTEM.
123 \[emu-nemacs.el; EMACS 20 emulating function]"
124 (if (eq coding-system 3)
126 (convert-string-kanji-code string 3 coding-system)
129 (defun decode-coding-region (start end coding-system)
130 "Decode the text between START and END which is encoded in CODING-SYSTEM.
131 \[emu-nemacs.el; EMACS 20 emulating function]"
135 (narrow-to-region start end)
136 (convert-region-kanji-code start end coding-system 3)
139 (defun encode-coding-region (start end coding-system)
140 "Encode the text between START and END to CODING-SYSTEM.
141 \[emu-nemacs.el; EMACS 20 emulating function]"
145 (narrow-to-region start end)
146 (convert-region-kanji-code start end 3 coding-system)
149 (defun detect-coding-region (start end)
150 "Detect coding-system of the text in the region between START and END.
151 \[emu-nemacs.el; Emacs 20 emulating function]"
154 (narrow-to-region start end)
156 (re-search-forward "[\200-\377]" nil t)
161 (defalias 'set-buffer-file-coding-system 'set-kanji-fileio-code)
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 (defmacro as-binary-output-file (&rest body)
183 ;;; @@ for old MULE emulation
186 (defun code-convert-string (str ic oc)
187 "Convert code in STRING from SOURCE code to TARGET code,
188 On successful converion, returns the result string,
189 else returns nil. [emu-nemacs.el; Mule emulating function]"
191 (convert-string-kanji-code str ic oc)
194 (defun code-convert-region (beg end ic oc)
195 "Convert code of the text between BEGIN and END from SOURCE
196 to TARGET. On successful conversion returns t,
197 else returns nil. [emu-nemacs.el; Mule emulating function]"
201 (narrow-to-region beg end)
202 (convert-region-kanji-code beg end ic oc)
209 (defun insert-binary-file-contents-literally (filename
210 &optional visit beg end replace)
211 "Like `insert-file-contents-literally', q.v., but don't code conversion.
212 A buffer may be modified in several ways after reading into the buffer due
213 to advanced Emacs features, such as file-name-handlers, format decoding,
214 find-file-hooks, etc.
215 This function ensures that none of these modifications will take place.
218 (insert-file-contents-literally filename visit beg end replace)
221 (defun insert-binary-file-contents (filename &optional visit beg end replace)
222 "Like `insert-file-contents', q.v., but don't code and format conversion.
225 (insert-file-contents filename visit beg end replace)
228 (defun write-region-as-binary (start end filename
229 &optional append visit lockname)
230 "Like `write-region', q.v., but don't code conversion. [emu-nemacs.el]"
232 (write-region start end filename append visit)
239 (defvar charsets-mime-charset-alist
240 (list (cons (list charset-ascii) 'us-ascii)))
242 (defvar default-mime-charset 'iso-2022-jp)
244 (defvar mime-charset-coding-system-alist
249 (defun mime-charset-to-coding-system (charset)
250 (if (stringp charset)
251 (setq charset (intern (downcase charset)))
253 (cdr (assq charset mime-charset-coding-system-alist))
256 (defun detect-mime-charset-region (start end)
257 "Return MIME charset for region between START and END.
261 (narrow-to-region start end)
263 (re-search-forward "[\200-\377]" nil t)
268 (defun encode-mime-charset-region (start end charset)
269 "Encode the text between START and END as MIME CHARSET.
271 (let ((cs (mime-charset-to-coding-system charset)))
276 (narrow-to-region start end)
277 (convert-region-kanji-code start end 3 cs)
281 (defun decode-mime-charset-region (start end charset)
282 "Decode the text between START and END as MIME CHARSET.
284 (let ((cs (mime-charset-to-coding-system charset)))
289 (narrow-to-region start end)
290 (convert-region-kanji-code start end cs 3)
294 (defun encode-mime-charset-string (string charset)
295 "Encode the STRING as MIME CHARSET. [emu-nemacs.el]"
296 (let ((cs (mime-charset-to-coding-system charset)))
298 (convert-string-kanji-code string 3 cs)
301 (defun decode-mime-charset-string (string charset)
302 "Decode the STRING as MIME CHARSET. [emu-nemacs.el]"
303 (let ((cs (mime-charset-to-coding-system charset)))
305 (convert-string-kanji-code string cs 3)
312 (defun char-charset (chr)
313 "Return the character set of char CHR.
314 \[emu-nemacs.el; XEmacs 20 emulating function]"
319 (defun char-bytes (chr)
320 "Return number of bytes CHAR will occupy in a buffer.
321 \[emu-nemacs.el; Mule emulating function]"
322 (if (< chr 128) 1 2))
324 (defalias 'char-length 'char-bytes)
326 (defun char-columns (character)
327 "Return number of columns a CHARACTER occupies when displayed.
329 (if (< character 128)
333 ;;; @@ for Mule emulation
336 (defalias 'char-leading-char 'char-charset)
338 (defalias 'char-width 'char-columns)
344 (defalias 'string-columns 'length)
346 (defun sref (str idx)
347 "Return the character in STR at index IDX.
348 \[emu-nemacs.el; Mule emulating function]"
349 (let ((chr (aref str idx)))
352 (logior (lsh (aref str (1+ idx)) 8) chr)
355 (defun string-to-char-list (str)
356 (let ((i 0)(len (length str)) dest chr)
358 (setq chr (aref str i))
361 chr (+ (lsh chr 8) (aref str i))
363 (setq dest (cons chr dest))
369 (fset 'string-to-int-list (symbol-function 'string-to-char-list))
371 ;;; Imported from Mule-2.3
372 (defun truncate-string (str width &optional start-column)
373 "Truncate STR to fit in WIDTH columns.
374 Optional non-nil arg START-COLUMN specifies the starting column.
375 \[emu-mule.el; Mule 2.3 emulating function]"
377 (setq start-column 0))
378 (let ((max-width (string-width str))
383 (if (>= width max-width)
384 (setq width max-width))
385 (if (>= start-column width)
387 (while (< column start-column)
388 (setq ch (aref str from)
389 column (+ column (char-columns ch))
390 from (+ from (char-bytes ch))))
391 (if (< width max-width)
394 (while (<= column width)
395 (setq ch (aref str to)
396 column (+ column (char-columns ch))
398 to (+ to (char-bytes ch))))
400 (substring str from to))))
402 ;;; @@ for Mule emulation
405 (defalias 'string-width 'length)
408 ;;; @ text property emulation
411 (defvar emu:available-face-attribute-alist
413 ;;(bold . inversed-region)
414 (italic . underlined-region)
415 (underline . underlined-region)
418 ;; by YAMATE Keiichirou 1994/10/28
419 (defun attribute-add-narrow-attribute (attr from to)
420 (or (consp (symbol-value attr))
422 (let* ((attr-value (symbol-value attr))
423 (len (car attr-value))
426 (while (and (< posfrom len)
427 (> from (nth posfrom attr-value)))
428 (setq posfrom (1+ posfrom)))
430 (while (and (< posto len)
431 (> to (nth posto attr-value)))
432 (setq posto (1+ posto)))
433 (if (= posto posfrom)
434 (if (= (% posto 2) 1)
436 (= to (nth posto attr-value)))
437 (set-marker (nth posto attr-value) from)
438 (setcdr (nthcdr (1- posfrom) attr-value)
439 (cons (set-marker-type (set-marker (make-marker)
442 (cons (set-marker-type (set-marker (make-marker)
445 (nthcdr posto attr-value))))
446 (setcar attr-value (+ len 2))))
447 (if (= (% posfrom 2) 0)
448 (setq posfrom (1- posfrom))
449 (set-marker (nth posfrom attr-value) from))
450 (if (= (% posto 2) 0)
452 (setq posto (1- posto))
453 (set-marker (nth posto attr-value) to))
454 (setcdr (nthcdr posfrom attr-value)
455 (nthcdr posto attr-value)))))
457 (defalias 'make-overlay 'cons)
459 (defun overlay-put (overlay prop value)
460 (let ((ret (and (eq prop 'face)
461 (assq value emu:available-face-attribute-alist)
464 (attribute-add-narrow-attribute (cdr ret)
465 (car overlay)(cdr overlay))
472 (provide 'emu-nemacs)
474 ;;; emu-nemacs.el ends here