1 ;;; mule.el --- basic commands for mulitilingual environment
3 ;; Copyright (C) 1995 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
6 ;; Keywords: mule, multilingual, character set, coding system
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU 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.
27 (defconst mule-version "3.0 (MOMIJINOGA)" "\
28 Version number and name of this version of MULE (multilingual environment).")
30 (defconst mule-version-date "1998.1.1" "\
31 Distribution date of this version of MULE (multilingual environment).")
33 (defun load-with-code-conversion (fullname file &optional noerror nomessage)
34 "Execute a file of Lisp code named FILE whose absolute path is FULLNAME.
35 The FILE is decoded before evaluation if necessary.
36 If optional second arg NOERROR is non-nil,
37 report no error if FILE doesn't exist.
38 Print messages at start and end of loading unless
39 optional third arg NOMESSAGE is non-nil.
40 Return t if file exists."
41 (if (null (file-readable-p fullname))
43 (signal 'file-error (list "Cannot open load file" file)))
44 ;; Read file with code conversion, and then eval.
46 ;; To avoid any autoloading, set default-major-mode to
48 (let ((default-major-mode 'fundamental-mode))
49 ;; We can't use `generate-new-buffer' because files.el
51 (get-buffer-create (generate-new-buffer-name " *load*"))))
53 (or nomessage (message "Loading %s..." file))
58 (insert-file-contents fullname)
59 ;; We must set `buffer-file-name' for `eval-buffer' and
61 (setq buffer-file-name file)
62 ;; Make `kill-buffer' quiet.
63 (set-buffer-modified-p nil))
64 ;; Eval in the original buffer.
67 (let ((hook (assoc file after-load-alist)))
69 (mapcar (function eval) (cdr hook))))
70 (or nomessage noninteractive
71 (message "Loading %s...done" file))
74 ;; API (Application Program Interface) for charsets.
76 ;; Return t if OBJ is a quoted symbol.
77 (defsubst quoted-symbol-p (obj)
78 (and (listp obj) (eq (car obj) 'quote)))
80 (defsubst charsetp (object)
81 "T is OBJECT is a charset."
82 (and (symbolp object) (vectorp (get object 'charset))))
84 (defsubst charset-info (charset)
85 "Return a vector of information of CHARSET.
86 The elements of the vector are:
87 CHARSET-ID, BYTES, DIMENSION, CHARS, WIDTH, DIRECTION,
88 LEADING-CODE-BASE, LEADING-CODE-EXT,
89 ISO-FINAL-CHAR, ISO-GRAPHIC-PLANE,
90 REVERSE-CHARSET, SHORT-NAME, LONG-NAME, DESCRIPTION,
93 CHARSET-ID (integer) is the identification number of the charset.
94 DIMENSION (integer) is the number of bytes to represent a character of
96 CHARS (integer) is the number of characters in a dimension: 94 or 96.
97 BYTE (integer) is the length of multi-byte form of a character in
98 the charset: one of 1, 2, 3, and 4.
99 WIDTH (integer) is the number of columns a character in the charset
100 occupies on the screen: one of 0, 1, and 2.
101 DIRECTION (integer) is the rendering direction of characters in the
102 charset when rendering. If 0, render from right to left, else
103 render from left to right.
104 LEADING-CODE-BASE (integer) is the base leading-code for the
106 LEADING-CODE-EXT (integer) is the extended leading-code for the
107 charset. All charsets of less than 0xA0 has the value 0.
108 ISO-FINAL-CHAR (character) is the final character of the
109 corresponding ISO 2022 charset.
110 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
111 while encoding to variants of ISO 2022 coding system, one of the
112 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
113 REVERSE-CHARSET (integer) is the charset which differs only in
114 LEFT-TO-RIGHT value from the charset. If there's no such a
115 charset, the value is -1.
116 SHORT-NAME (string) is the short name to refer to the charset.
117 LONG-NAME (string) is the long name to refer to the charset
118 DESCRIPTION (string) is the description string of the charset.
119 PLIST (property list) may contain any type of information a user
120 want to put and get by functions `put-charset-property' and
121 `get-charset-property' respectively."
122 (get charset 'charset))
124 (defmacro charset-id (charset)
125 "Return charset identification number of CHARSET."
126 (if (and (listp charset) (eq (car charset) 'quote))
127 (aref (charset-info (nth 1 charset)) 0)
128 `(aref (charset-info ,charset) 0)))
130 (defmacro charset-bytes (charset)
131 (if (quoted-symbol-p charset)
132 (aref (charset-info (nth 1 charset)) 1)
133 `(aref (charset-info ,charset) 1)))
135 (defmacro charset-dimension (charset)
136 (if (quoted-symbol-p charset)
137 (aref (charset-info (nth 1 charset)) 2)
138 `(aref (charset-info ,charset) 2)))
140 (defmacro charset-chars (charset)
141 (if (quoted-symbol-p charset)
142 (aref (charset-info (nth 1 charset)) 3)
143 `(aref (charset-info ,charset) 3)))
145 (defmacro charset-width (charset)
146 (if (quoted-symbol-p charset)
147 (aref (charset-info (nth 1 charset)) 4)
148 `(aref (charset-info ,charset) 4)))
150 (defmacro charset-direction (charset)
151 (if (quoted-symbol-p charset)
152 (aref (charset-info (nth 1 charset)) 5)
153 `(aref (charset-info ,charset) 5)))
155 (defmacro charset-iso-final-char (charset)
156 (if (quoted-symbol-p charset)
157 (aref (charset-info (nth 1 charset)) 8)
158 `(aref (charset-info ,charset) 8)))
160 (defmacro charset-iso-graphic-plane (charset)
161 (if (quoted-symbol-p charset)
162 (aref (charset-info (nth 1 charset)) 9)
163 `(aref (charset-info ,charset) 9)))
165 (defmacro charset-reverse-charset (charset)
166 (if (quoted-symbol-p charset)
167 (aref (charset-info (nth 1 charset)) 10)
168 `(aref (charset-info ,charset) 10)))
170 (defmacro charset-short-name (charset)
171 (if (quoted-symbol-p charset)
172 (aref (charset-info (nth 1 charset)) 11)
173 `(aref (charset-info ,charset) 11)))
175 (defmacro charset-long-name (charset)
176 (if (quoted-symbol-p charset)
177 (aref (charset-info (nth 1 charset)) 12)
178 `(aref (charset-info ,charset) 12)))
180 (defmacro charset-description (charset)
181 (if (quoted-symbol-p charset)
182 (aref (charset-info (nth 1 charset)) 13)
183 `(aref (charset-info ,charset) 13)))
185 (defmacro charset-plist (charset)
186 (if (quoted-symbol-p charset)
187 `(aref ,(charset-info (nth 1 charset)) 14)
188 `(aref (charset-info ,charset) 14)))
190 (defun set-charset-plist (charset plist)
191 (aset (charset-info charset) 14 plist))
193 (defmacro make-char (charset &optional c1 c2)
194 "Return a character of CHARSET and position-codes CODE1 and CODE2.
195 CODE1 and CODE2 are optional, but if you don't supply
196 sufficient position-codes, return a generic character which stands for
197 all characters or group of characters in the character sets.
198 A generic character can be an argument of `modify-syntax-entry' and
199 `modify-category-entry'."
200 (if (quoted-symbol-p charset)
201 `(make-char-internal ,(charset-id (nth 1 charset)) ,c1 ,c2)
202 `(make-char-internal (charset-id ,charset) ,c1 ,c2)))
204 (defmacro charset-list ()
205 "Return list of charsets ever defined."
208 ;; Coding-system staffs
210 ;; Coding-system object is a symbol that has the property
211 ;; `coding-system' and `eol-type'.
213 ;; The value of the property `coding-system' is a coding-vector of the
214 ;; format: [TYPE MNEMONIC DOCSTRING NOT-USED-NOW FLAGS].
215 ;; See comments in src/coding.c for more detail. The property value
216 ;; may be another coding-system, in which case, the coding-vector
217 ;; should be taken from that coding-system.
219 ;; The value of the property `eol-type' is integer 0..2 or a vector of
220 ;; length 3. The integer value 0, 1, and 2 indicate the format of
221 ;; end-of-line LF, CRLF, and CR respectively. The vector value
222 ;; indicates that the format of end-of-line should be detected
223 ;; automatically. Nth element of the vector is the subsidiary
224 ;; coding-system whose `eol-type' property is integer value.
226 ;; Coding-system may also have properties `post-read-conversion' and
227 ;; `pre-write-conversion and the values are functions.
229 ;; The function in `post-read-conversion' is called after some text is
230 ;; inserted and decoded along the coding-system and before any
231 ;; functions in `after-insert-functions' are called. The arguments to
232 ;; this function is the same as those of a function in
233 ;; `after-insert-functions', i.e. LENGTH of a text while putting point
234 ;; at the head of the text to be decoded
236 ;; The function in `pre-write-conversion' is called after all
237 ;; functions in `write-region-annotate-functions' and
238 ;; `buffer-file-format' are called, and before the text is encoded by
239 ;; the coding-system. The arguments to this function is the same as
240 ;; those of a function in `write-region-annotate-functions', i.e. FROM
241 ;; and TO specifying region of a text.
243 (defsubst coding-vector-type (vec) (aref vec 0))
244 (defsubst coding-vector-mnemonic (vec) (aref vec 1))
245 (defsubst coding-vector-docstring (vec) (aref vec 2))
246 (defsubst coding-vector-flags (vec) (aref vec 4))
248 ;; Return type of CODING-SYSTEM.
249 (defun coding-system-type (coding-system)
250 (check-coding-system coding-system)
251 (let ((vec (coding-system-vector coding-system)))
252 (if vec (coding-vector-type vec))))
254 ;; Return mnemonic character of CODING-SYSTEM.
255 (defun coding-system-mnemonic (coding-system)
256 (check-coding-system coding-system)
257 (let ((vec (coding-system-vector coding-system)))
258 (if vec (coding-vector-mnemonic vec)
261 ;; Return docstring of CODING-SYSTEM.
262 (defun coding-system-docstring (coding-system)
263 (check-coding-system coding-system)
264 (let ((vec (coding-system-vector coding-system)))
265 (if vec (coding-vector-docstring vec))))
267 ;; Return flags of CODING-SYSTEM.
268 (defun coding-system-flags (coding-system)
269 (check-coding-system coding-system)
270 (let ((vec (coding-system-vector coding-system)))
271 (if vec (coding-vector-flags vec))))
273 ;; Return eol-type of CODING-SYSTEM.
274 (defun coding-system-eoltype (coding-system)
275 (check-coding-system coding-system)
277 (or (get coding-system 'eol-type)
278 (coding-system-eoltype (get coding-system 'coding-system)))))
280 ;; Return mnemonic character of eol-type of CODING-SYSTEM.
281 (defun coding-system-eoltype-mnemonic (coding-system)
282 (let ((eol-type (coding-system-eoltype coding-system)))
283 (cond ((vectorp eol-type) eol-mnemonic-undecided)
284 ((eq eol-type 0) eol-mnemonic-unix)
285 ((eq eol-type 1) eol-mnemonic-unix)
286 ((eq eol-type 2) eol-mnemonic-unix)
289 ;; Return function for post-read-conversion of CODING-SYSTEM.
290 (defun coding-system-post-read-conversion (coding-system)
292 (symbolp coding-system)
293 (or (get coding-system 'post-read-conversion)
294 (coding-system-post-read-conversion
295 (get coding-system 'coding-system)))))
297 ;; Return function for pre-write-conversion of CODING-SYSTEM.
298 (defun coding-system-pre-write-conversion (coding-system)
300 (symbolp coding-system)
301 (or (get coding-system 'pre-write-conversion)
302 (coding-system-pre-write-conversion
303 (get coding-system 'coding-system)))))
305 (defun make-coding-system (coding-system type mnemonic docstring
307 "Define a new CODING-SYSTEM (symbol).
308 Remaining arguments are TYPE, MNEMONIC, DOCSTRING, and FLAGS (optional).
309 TYPE is an integer value indicating the type of coding-system as follows:
310 0: Emacs internal format,
311 1: Shift-JIS (or MS-Kanji) used mainly on Japanese PC,
312 2: ISO-2022 including many variants,
313 3: Big5 used mainly on Chinese PC,
314 4: private, CCL programs provide encoding/decoding algorithm.
315 MNEMONIC is a character to be displayed on mode line for the coding-system.
316 DOCSTRING is a documentation string for the coding-system.
317 FLAGS specifies more precise information of each TYPE.
318 If TYPE is 2 (ISO-2022), FLAGS should be a list of:
319 CHARSET0, CHARSET1, CHARSET2, CHARSET3, SHORT-FORM,
320 ASCII-EOL, ASCII-CNTL, SEVEN, LOCKING-SHIFT, SINGLE-SHIFT,
321 USE-ROMAN, USE-OLDJIS, NO-ISO6429.
322 CHARSETn are character sets initially designated to Gn graphic registers.
323 If CHARSETn is nil, Gn is never used.
324 If CHARSETn is t, Gn can be used but nothing designated initially.
325 If CHARSETn is a list of character sets, those character sets are
326 designated to Gn on output, but nothing designated to Gn initially.
327 SHORT-FORM non-nil means use short designation sequence on output.
328 ASCII-EOL non-nil means designate ASCII to g0 at end of line on output.
329 ASCII-CNTL non-nil means designate ASCII to g0 before control codes and
331 SEVEN non-nil means use 7-bit code only on output.
332 LOCKING-SHIFT non-nil means use locking-shift.
333 SINGLE-SHIFT non-nil means use single-shift.
334 USE-ROMAN non-nil means designate JIS0201-1976-Roman instead of ASCII.
335 USE-OLDJIS non-nil means designate JIS0208-1976 instead of JIS0208-1983.
336 NO-ISO6429 non-nil means not use ISO6429's direction specification.
337 INIT-BOL non-nil means any designation state is assumed to be reset
338 to initial at each beginning of line on output.
339 DESIGNATION-BOL non-nil means designation sequences should be placed
340 at beginning of line on output.
341 If TYPE is 4 (private), FLAGS should be a cons of CCL programs,
342 for encoding and decoding. See the documentation of CCL for more detail."
344 ;; At first, set a value of `coding-system' property.
345 (let ((coding-vector (make-vector 5 nil)))
346 (aset coding-vector 0 type)
347 (aset coding-vector 1
348 ;; MNEMONIC must be a printable character.
349 (if (and (> mnemonic ? ) (< mnemonic 127)) mnemonic ? ))
350 (aset coding-vector 2 (if (stringp docstring) docstring ""))
351 (aset coding-vector 3 nil) ; obsolete element
352 (cond ((eq type 2) ; ISO2022
354 (vec (make-vector 32 nil)))
356 (let ((charset (car flags)))
357 (or (not charset) (eq charset t) (charsetp charset)
358 (if (not (listp charset))
359 (error "Invalid charset: %s" charset)
362 (setq elt (car charset))
363 (or (not elt) (eq elt t) (charsetp elt)
364 (error "Invalid charset: %s" elt))
365 (setq l (cons elt l))
366 (setq charset (cdr charset)))
367 (setq charset (nreverse l)))))
368 (aset vec i charset))
369 (setq flags (cdr flags) i (1+ i)))
370 (while (and (< i 32) flags)
371 (aset vec i (car flags))
372 (setq flags (cdr flags) i (1+ i)))
373 (aset coding-vector 4 vec)))
374 ((eq type 4) ; private
375 (if (and (consp flags)
376 (vectorp (car flags))
377 (vectorp (cdr flags)))
378 (aset coding-vector 4 flags)
379 (error "Invalid FLAGS argument for TYPE 4 (CCL)")))
380 (t (aset coding-vector 4 flags)))
381 (put coding-system 'coding-system coding-vector))
383 ;; Next, set a value of `eol-type' property. The value is a vector
384 ;; of subsidiary coding-systems, each corresponds to a coding-system
385 ;; for the detected end-of-line format.
386 (let ((codings (vector (intern (format "%s-unix" coding-system))
387 (intern (format "%s-dos" coding-system))
388 (intern (format "%s-mac" coding-system))))
391 (put (aref codings i) 'coding-system coding-system)
392 (put (aref codings i) 'eol-type i)
394 (put coding-system 'eol-type codings))
397 (defun define-coding-system-alias (symbol new-symbol)
398 "Define NEW-SYMBOL as the same coding system as SYMBOL."
399 (check-coding-system symbol)
400 (put new-symbol 'coding-system symbol)
401 (let ((eol-type (coding-system-eoltype symbol)))
402 (if (vectorp eol-type)
403 (let* ((name (symbol-name new-symbol))
404 (new-eol-type (vector (intern (concat name "-unix"))
405 (intern (concat name "-dos"))
406 (intern (concat name "-mac")))))
407 (define-coding-system-alias (aref eol-type 0) (aref new-eol-type 0))
408 (define-coding-system-alias (aref eol-type 1) (aref new-eol-type 1))
409 (define-coding-system-alias (aref eol-type 2) (aref new-eol-type 2))
410 (setq eol-type new-eol-type)))
411 (put new-symbol 'eol-type eol-type)))
413 (defvar buffer-file-coding-system nil
414 "Coding-system of the file which the current-buffer is visiting.")
415 (make-variable-buffer-local 'buffer-file-coding-system)
416 ;; This value should not be reset by changing major mode.
417 (put 'buffer-file-coding-system 'permanent-local t)
419 (defun set-buffer-file-coding-system (coding-system &optional force)
420 "Set buffer-file-coding-system of the current buffer to CODING-SYSTEM.
421 If eol-type of the current buffer-file-coding-system is an integer value N, and
422 eol-type of CODING-SYSTEM is a vector, the Nth element of the vector is set
423 instead of CODING-SYSTEM itself.
424 Optional prefix argument FORCE non-nil means CODING-SYSTEM is set
425 regardless of eol-type of the current buffer-file-coding-system."
426 (interactive "zBuffer-file-coding-system: \nP")
427 (check-coding-system coding-system)
429 (let ((x (coding-system-eoltype buffer-file-coding-system))
430 (y (coding-system-eoltype coding-system)))
431 (if (and (numberp x) (>= x 0) (<= x 2) (vectorp y))
432 (setq coding-system (aref y x)))))
433 (setq buffer-file-coding-system coding-system)
434 (set-buffer-modified-p t)
435 (force-mode-line-update))
437 (defun set-current-process-coding-system (input output)
439 "zCoding-system for process input: \nzCoding-system for process output: ")
440 (let ((proc (get-buffer-process (current-buffer))))
443 (check-coding-system input)
444 (check-coding-system output)
445 (set-process-coding-system proc input output)))
446 (force-mode-line-update))
448 (defvar default-process-coding-system (cons nil nil)
449 "Cons of default values used to read from and write to process.")
451 (defun set-coding-priority (arg)
452 "Set priority of coding-category according to LIST.
453 LIST is a list of coding-categories ordered by priority."
455 ;; Put coding-categories listed in ARG to L while checking the
456 ;; validity. We assume that `coding-category-list' contains whole
457 ;; coding-categories.
459 (if (null (memq (car arg) coding-category-list))
460 (error "Invalid element in argument: %s" (car arg)))
461 (setq l (cons (car arg) l))
462 (setq arg (cdr arg)))
463 ;; Put coding-category not listed in ARG to L.
464 (while coding-category-list
465 (if (null (memq (car coding-category-list) l))
466 (setq l (cons (car coding-category-list) l)))
467 (setq coding-category-list (cdr coding-category-list)))
468 ;; Update `coding-category-list' and return it.
469 (setq coding-category-list (nreverse l))))
473 ;; Set buffer-file-coding-system of the current buffer after some text
475 (defun after-insert-file-set-buffer-file-coding-system (inserted)
476 (if last-coding-system-used
478 (find-new-buffer-file-coding-system last-coding-system-used))
479 (modified-p (buffer-modified-p)))
481 (set-buffer-file-coding-system coding-system))
482 (set-buffer-modified-p modified-p)))
485 (setq after-insert-file-functions
486 (cons 'after-insert-file-set-buffer-file-coding-system
487 after-insert-file-functions))
489 ;; The coding-vector and eol-type of coding-system returned is decided
490 ;; independently in the following order.
491 ;; 1. That of buffer-file-coding-system locally bound.
492 ;; 2. That of CODING.
494 (defun find-new-buffer-file-coding-system (coding)
495 "Return a coding system for a buffer when a file of CODING is inserted.
496 The returned value is set to `buffer-file-coding-system' of the
497 current buffer. Return nil if there's no need of setting new
498 buffer-file-coding-system."
499 (let (local-coding local-eol
503 ;; Nothing found about coding.
506 ;; Get information of the current local value of
507 ;; `buffer-file-coding-system' in LOCAL-EOL and LOCAL-CODING.
508 (if (local-variable-p 'buffer-file-coding-system)
509 ;; Something already set locally.
511 (setq local-eol (coding-system-eoltype buffer-file-coding-system))
512 (if (null (numberp local-eol))
513 ;; But eol-type is not yet set.
514 (setq local-eol nil))
515 (if (null (eq (coding-system-type buffer-file-coding-system) t))
516 ;; This is not automatic-conversion.
518 (setq local-coding buffer-file-coding-system)
519 (while (symbolp (get local-coding 'coding-system))
520 (setq local-coding (get local-coding 'coding-system))))
523 (if (and local-eol local-coding)
524 ;; The current buffer has already set full coding-system, we
525 ;; had better not change it.
528 (setq found-eol (coding-system-eoltype coding))
529 (if (null (numberp found-eol))
530 ;; But eol-type is not found.
531 (setq found-eol nil))
532 (if (eq (coding-system-type coding) t)
533 ;; This is automatic-conversion, which means nothing found
534 ;; except for eol-type.
537 ;; The local setting takes precedence over the found one.
538 (setq new-coding (or local-coding coding))
539 (setq new-eol (or local-eol found-eol))
540 (if (and (numberp new-eol)
541 (vectorp (coding-system-eoltype new-coding)))
543 (aref (coding-system-eoltype new-coding) new-eol)))
546 ;;; Initialize some variables.
548 (put 'use-default-ascent 'char-table-extra-slots 0)
549 (setq use-default-ascent (make-char-table 'use-default-ascent))
554 ;;; mule.el ends here