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.
34 'charset-description "Character set of ASCII")
36 'charset-registry "ASCII")
38 (put 'japanese-jisx0208
39 'charset-description "Character set of JIS X0208-1983")
40 (put 'japanese-jisx0208
41 'charset-registry "JISX0208.1983")
43 (defun charset-description (charset)
44 "Return description of CHARSET. [emu-nemacs.el]"
45 (get charset 'charset-description))
47 (defun charset-registry (charset)
48 "Return registry name of CHARSET. [emu-nemacs.el]"
49 (get charset 'charset-registry))
51 (defun charset-width (charset)
52 "Return number of columns a CHARSET occupies when displayed.
54 (if (eq charset 'ascii)
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 (defalias 'find-non-ascii-charset-string 'find-charset-string)
72 (defun find-charset-region (start end)
73 "Return a list of charsets in the region between START and END.
74 \[emu-nemacs.el; Mule emulating function]"
77 (narrow-to-region start end)
79 (re-search-forward "[\200-\377]" nil t)))
83 (defalias 'find-non-ascii-charset-region 'find-charset-region)
85 (defun check-ASCII-string (str)
88 (setq len (length str))
91 (if (>= (elt str i) 128)
96 ;;; @@ for old MULE emulation
99 ;;(defconst lc-ascii 0)
100 ;;(defconst lc-jp 146)
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)))
120 (defun encode-coding-string (string coding-system)
121 "Encode the STRING to CODING-SYSTEM.
122 \[emu-nemacs.el; EMACS 20 emulating function]"
123 (if (eq coding-system 3)
125 (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 detect-coding-region (start end)
148 "Detect coding-system of the text in the region between START and END.
149 \[emu-nemacs.el; Emacs 20 emulating function]"
152 (narrow-to-region start end)
154 (re-search-forward "[\200-\377]" nil t)))
158 (defalias 'set-buffer-file-coding-system 'set-kanji-fileio-code)
161 ;;; @@ for old MULE emulation
164 (defun code-convert-string (str ic oc)
165 "Convert code in STRING from SOURCE code to TARGET code,
166 On successful converion, returns the result string,
167 else returns nil. [emu-nemacs.el; Mule emulating function]"
169 (convert-string-kanji-code str ic oc)
172 (defun code-convert-region (beg end ic oc)
173 "Convert code of the text between BEGIN and END from SOURCE
174 to TARGET. On successful conversion returns t,
175 else returns nil. [emu-nemacs.el; Mule emulating function]"
179 (narrow-to-region beg end)
180 (convert-region-kanji-code beg end ic oc)))
184 ;;; @ without code-conversion
187 (defmacro as-binary-process (&rest body)
188 (` (let (selective-display ; Disable ^M to nl translation.
191 (default-kanji-process-code 0)
192 program-kanji-code-alist)
195 (defmacro as-binary-input-file (&rest body)
199 (defmacro as-binary-output-file (&rest body)
203 (defun write-region-as-binary (start end filename
204 &optional append visit lockname)
205 "Like `write-region', q.v., but don't code conversion. [emu-nemacs.el]"
206 (as-binary-output-file
207 (write-region start end filename append visit)))
209 (defun insert-file-contents-as-binary (filename
210 &optional visit beg end replace)
211 "Like `insert-file-contents', q.v., but don't character code conversion.
213 (as-binary-input-file
214 ;; Returns list absolute file name and length of data inserted.
215 (insert-file-contents filename visit beg end replace)))
217 (fset 'insert-binary-file-contents 'insert-file-contents-as-binary)
219 (defun insert-binary-file-contents-literally (filename
220 &optional visit beg end replace)
221 "Like `insert-file-contents-literally', q.v., but don't code conversion.
222 A buffer may be modified in several ways after reading into the buffer due
223 to advanced Emacs features, such as file-name-handlers, format decoding,
224 find-file-hooks, etc.
225 This function ensures that none of these modifications will take place.
227 (as-binary-input-file
228 ;; Returns list absolute file name and length of data inserted.
229 (insert-file-contents-literally filename visit beg end replace)))
231 (defun insert-file-contents-as-raw-text (filename
232 &optional visit beg end replace)
233 "Like `insert-file-contents', q.v., but don't character code conversion.
235 (as-binary-input-file
236 ;; Returns list absolute file name and length of data inserted.
237 (insert-file-contents filename visit beg end replace)))
239 (defun write-region-as-raw-text-CRLF (start end filename
240 &optional append visit lockname)
241 "Like `write-region', q.v., but don't code conversion. [emu-nemacs.el]"
242 (let ((the-buf (current-buffer)))
244 (insert-buffer-substring the-buf start end)
245 (goto-char (point-min))
246 (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t)
247 (replace-match "\\1\r\n"))
248 (write-region-as-binary (point-min)(point-max)
249 filename append visit))))
255 (defvar charsets-mime-charset-alist
256 '(((ascii) . us-ascii)))
258 (defvar default-mime-charset 'iso-2022-jp)
260 (defvar mime-charset-coding-system-alist
265 (defun mime-charset-to-coding-system (charset)
266 (if (stringp charset)
267 (setq charset (intern (downcase charset)))
269 (cdr (assq charset mime-charset-coding-system-alist)))
271 (defun detect-mime-charset-region (start end)
272 "Return MIME charset for region between START and END.
276 (narrow-to-region start end)
278 (re-search-forward "[\200-\377]" nil t)))
282 (defun encode-mime-charset-region (start end charset)
283 "Encode the text between START and END as MIME CHARSET.
285 (let ((cs (mime-charset-to-coding-system charset)))
290 (narrow-to-region start end)
291 (convert-region-kanji-code start end 3 cs))))
294 (defun decode-mime-charset-region (start end charset &optional lbt)
295 "Decode the text between START and END as MIME CHARSET.
297 (let ((cs (mime-charset-to-coding-system charset))
298 (nl (cdr (assq lbt '((CRLF . "\r\n") (CR . "\r")
299 (dos . "\r\n") (mac . "\r"))))))
304 (narrow-to-region start end)
305 (convert-region-kanji-code start end cs 3)
308 (goto-char (point-min))
309 (while (search-forward nl nil t)
310 (replace-match "\n")))
314 (defun encode-mime-charset-string (string charset)
315 "Encode the STRING as MIME CHARSET. [emu-nemacs.el]"
316 (let ((cs (mime-charset-to-coding-system charset)))
318 (convert-string-kanji-code string 3 cs)
321 (defun decode-mime-charset-string (string charset &optional lbt)
322 "Decode the STRING as MIME CHARSET. [emu-nemacs.el]"
325 (decode-mime-charset-region (point-min)(point-max) charset lbt)
328 (defun write-region-as-mime-charset (charset start end filename)
329 "Like `write-region', q.v., but code-convert by MIME CHARSET.
331 (let ((kanji-fileio-code
332 (or (mime-charset-to-coding-system charset)
334 (write-region start end filename)))
337 ;;; @ buffer representation
340 (defsubst-maybe set-buffer-multibyte (flag)
341 "Set the multibyte flag of the current buffer to FLAG.
342 If FLAG is t, this makes the buffer a multibyte buffer.
343 If FLAG is nil, this makes the buffer a single-byte buffer.
344 The buffer contents remain unchanged as a sequence of bytes
345 but the contents viewed as characters do change.
346 \[Emacs 20.3 emulating function]"
347 (setq kanji-flag flag)
354 (defun char-charset (chr)
355 "Return the character set of char CHR.
356 \[emu-nemacs.el; MULE emulating function]"
361 (defun char-bytes (chr)
362 "Return number of bytes CHAR will occupy in a buffer.
363 \[emu-nemacs.el; Mule emulating function]"
368 (defun char-width (char)
369 "Return number of columns a CHAR occupies when displayed.
375 (defalias 'char-length 'char-bytes)
377 (defmacro char-next-index (char index)
378 "Return index of character succeeding CHAR whose index is INDEX."
379 (` (+ (, index) (char-bytes (, char)))))
385 (defalias 'string-width 'length)
387 (defun sref (str idx)
388 "Return the character in STR at index IDX.
389 \[emu-nemacs.el; Mule emulating function]"
390 (let ((chr (aref str idx)))
393 (logior (lsh (aref str (1+ idx)) 8) chr))))
395 (defun string-to-char-list (str)
396 (let ((i 0)(len (length str)) dest chr)
398 (setq chr (aref str i))
401 chr (+ (lsh chr 8) (aref str i)))
403 (setq dest (cons chr dest))
407 (fset 'string-to-int-list (symbol-function 'string-to-char-list))
409 ;;; Imported from Mule-2.3
410 (defun truncate-string (str width &optional start-column)
411 "Truncate STR to fit in WIDTH columns.
412 Optional non-nil arg START-COLUMN specifies the starting column.
413 \[emu-mule.el; Mule 2.3 emulating function]"
415 (setq start-column 0))
416 (let ((max-width (string-width str))
421 (if (>= width max-width)
422 (setq width max-width))
423 (if (>= start-column width)
425 (while (< column start-column)
426 (setq ch (aref str from)
427 column (+ column (char-columns ch))
428 from (+ from (char-bytes ch))))
429 (if (< width max-width)
432 (while (<= column width)
433 (setq ch (aref str to)
434 column (+ column (char-columns ch))
436 to (+ to (char-bytes ch))))
438 (substring str from to))))
440 (defalias 'looking-at-as-unibyte 'looking-at)
442 ;;; @@ obsoleted aliases
444 ;;; You should not use them.
446 (defalias 'string-columns 'length)
449 ;;; @ text property emulation
452 (defvar emu:available-face-attribute-alist
454 ;;(bold . inversed-region)
455 (italic . underlined-region)
456 (underline . underlined-region)
459 ;; by YAMATE Keiichirou 1994/10/28
460 (defun attribute-add-narrow-attribute (attr from to)
461 (or (consp (symbol-value attr))
463 (let* ((attr-value (symbol-value attr))
464 (len (car attr-value))
467 (while (and (< posfrom len)
468 (> from (nth posfrom attr-value)))
469 (setq posfrom (1+ posfrom)))
471 (while (and (< posto len)
472 (> to (nth posto attr-value)))
473 (setq posto (1+ posto)))
474 (if (= posto posfrom)
475 (if (= (% posto 2) 1)
477 (= to (nth posto attr-value)))
478 (set-marker (nth posto attr-value) from)
479 (setcdr (nthcdr (1- posfrom) attr-value)
480 (cons (set-marker-type (set-marker (make-marker)
483 (cons (set-marker-type (set-marker (make-marker)
486 (nthcdr posto attr-value))))
487 (setcar attr-value (+ len 2))))
488 (if (= (% posfrom 2) 0)
489 (setq posfrom (1- posfrom))
490 (set-marker (nth posfrom attr-value) from))
491 (if (= (% posto 2) 0)
493 (setq posto (1- posto))
494 (set-marker (nth posto attr-value) to))
495 (setcdr (nthcdr posfrom attr-value)
496 (nthcdr posto attr-value)))))
498 (defalias 'make-overlay 'cons)
500 (defun overlay-put (overlay prop value)
501 (let ((ret (and (eq prop 'face)
502 (assq value emu:available-face-attribute-alist)
505 (attribute-add-narrow-attribute (cdr ret)
506 (car overlay)(cdr overlay))
513 (provide 'emu-nemacs)
515 ;;; emu-nemacs.el ends here