Mercurial > emacs
annotate lisp/international/mule.el @ 17803:906dcb974266
Don't include term.el.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Wed, 14 May 1997 19:51:33 +0000 |
parents | c5f430853301 |
children | a4d3078a83e9 |
rev | line source |
---|---|
17052 | 1 ;;; mule.el --- basic commands for mulitilingual environment |
2 | |
3 ;; Copyright (C) 1995 Free Software Foundation, Inc. | |
4 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. | |
5 | |
6 ;; Keywords: mule, multilingual, character set, coding system | |
7 | |
8 ;; This file is part of GNU Emacs. | |
9 | |
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) | |
13 ;; any later version. | |
14 | |
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. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
17071 | 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. | |
17052 | 24 |
25 ;;; Code: | |
26 | |
27 (defconst mule-version "3.0 (MOMIJINOGA)" "\ | |
28 Version number and name of this version of MULE (multilingual environment).") | |
29 | |
30 (defconst mule-version-date "1998.1.1" "\ | |
31 Distribution date of this version of MULE (multilingual environment).") | |
32 | |
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)) | |
42 (and (null noerror) | |
43 (signal 'file-error (list "Cannot open load file" file))) | |
44 ;; Read file with code conversion, and then eval. | |
45 (let* ((buffer | |
46 ;; To avoid any autoloading, set default-major-mode to | |
47 ;; fundamental-mode. | |
48 (let ((default-major-mode 'fundamental-mode)) | |
49 ;; We can't use `generate-new-buffer' because files.el | |
50 ;; is not yet loaded. | |
51 (get-buffer-create (generate-new-buffer-name " *load*")))) | |
52 (load-in-progress t)) | |
53 (or nomessage (message "Loading %s..." file)) | |
54 (unwind-protect | |
55 (progn | |
56 (save-excursion | |
57 (set-buffer buffer) | |
58 (insert-file-contents fullname) | |
59 ;; We must set `buffer-file-name' for `eval-buffer' and | |
60 ;; `load-history'. | |
61 (setq buffer-file-name file) | |
62 ;; Make `kill-buffer' quiet. | |
63 (set-buffer-modified-p nil)) | |
64 ;; Eval in the original buffer. | |
65 (eval-buffer buffer)) | |
66 (kill-buffer buffer)) | |
67 (let ((hook (assoc file after-load-alist))) | |
68 (if hook | |
69 (mapcar (function eval) (cdr hook)))) | |
70 (or nomessage noninteractive | |
71 (message "Loading %s...done" file)) | |
72 t))) | |
73 | |
74 ;; API (Application Program Interface) for charsets. | |
75 | |
76 ;; Return t if OBJ is a quoted symbol. | |
77 (defsubst quoted-symbol-p (obj) | |
78 (and (listp obj) (eq (car obj) 'quote))) | |
79 | |
80 (defsubst charsetp (object) | |
81 "T is OBJECT is a charset." | |
82 (and (symbolp object) (vectorp (get object 'charset)))) | |
83 | |
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, | |
91 PLIST, | |
92 where | |
93 CHARSET-ID (integer) is the identification number of the charset. | |
94 DIMENSION (integer) is the number of bytes to represent a character of | |
95 the charset: 1 or 2. | |
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 | |
105 charset. | |
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)) | |
123 | |
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))) | |
129 | |
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))) | |
134 | |
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))) | |
139 | |
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))) | |
144 | |
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))) | |
149 | |
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))) | |
154 | |
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))) | |
159 | |
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))) | |
164 | |
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))) | |
169 | |
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))) | |
174 | |
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))) | |
179 | |
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))) | |
184 | |
185 (defmacro charset-plist (charset) | |
186 (if (quoted-symbol-p charset) | |
17175 | 187 `(aref ,(charset-info (nth 1 charset)) 14) |
17052 | 188 `(aref (charset-info ,charset) 14))) |
189 | |
190 (defun set-charset-plist (charset plist) | |
191 (aset (charset-info charset) 14 plist)) | |
192 | |
193 (defmacro make-char (charset &optional c1 c2) | |
17175 | 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. | |
17761
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
198 A generic character can be used to index a char table (e.g. syntax-table)." |
17052 | 199 (if (quoted-symbol-p charset) |
200 `(make-char-internal ,(charset-id (nth 1 charset)) ,c1 ,c2) | |
201 `(make-char-internal (charset-id ,charset) ,c1 ,c2))) | |
202 | |
17094
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
203 (defmacro charset-list () |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
204 "Return list of charsets ever defined." |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
205 charset-list) |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
206 |
17052 | 207 ;; Coding-system staffs |
208 | |
209 ;; Coding-system object is a symbol that has the property | |
210 ;; `coding-system' and `eol-type'. | |
211 ;; | |
212 ;; The value of the property `coding-system' is a coding-vector of the | |
213 ;; format: [TYPE MNEMONIC DOCSTRING NOT-USED-NOW FLAGS]. | |
214 ;; See comments in src/coding.c for more detail. The property value | |
215 ;; may be another coding-system, in which case, the coding-vector | |
216 ;; should be taken from that coding-system. | |
217 ;; | |
218 ;; The value of the property `eol-type' is integer 0..2 or a vector of | |
219 ;; length 3. The integer value 0, 1, and 2 indicate the format of | |
220 ;; end-of-line LF, CRLF, and CR respectively. The vector value | |
221 ;; indicates that the format of end-of-line should be detected | |
222 ;; automatically. Nth element of the vector is the subsidiary | |
223 ;; coding-system whose `eol-type' property is integer value. | |
224 ;; | |
225 ;; Coding-system may also have properties `post-read-conversion' and | |
226 ;; `pre-write-conversion and the values are functions. | |
227 ;; | |
228 ;; The function in `post-read-conversion' is called after some text is | |
229 ;; inserted and decoded along the coding-system and before any | |
230 ;; functions in `after-insert-functions' are called. The arguments to | |
231 ;; this function is the same as those of a function in | |
232 ;; `after-insert-functions', i.e. LENGTH of a text while putting point | |
233 ;; at the head of the text to be decoded | |
234 ;; | |
235 ;; The function in `pre-write-conversion' is called after all | |
236 ;; functions in `write-region-annotate-functions' and | |
237 ;; `buffer-file-format' are called, and before the text is encoded by | |
238 ;; the coding-system. The arguments to this function is the same as | |
239 ;; those of a function in `write-region-annotate-functions', i.e. FROM | |
240 ;; and TO specifying region of a text. | |
241 | |
242 (defsubst coding-vector-type (vec) (aref vec 0)) | |
243 (defsubst coding-vector-mnemonic (vec) (aref vec 1)) | |
244 (defsubst coding-vector-docstring (vec) (aref vec 2)) | |
245 (defsubst coding-vector-flags (vec) (aref vec 4)) | |
246 | |
247 ;; Return type of CODING-SYSTEM. | |
248 (defun coding-system-type (coding-system) | |
17094
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
249 (check-coding-system coding-system) |
17052 | 250 (let ((vec (coding-system-vector coding-system))) |
251 (if vec (coding-vector-type vec)))) | |
252 | |
253 ;; Return mnemonic character of CODING-SYSTEM. | |
254 (defun coding-system-mnemonic (coding-system) | |
17094
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
255 (check-coding-system coding-system) |
17052 | 256 (let ((vec (coding-system-vector coding-system))) |
257 (if vec (coding-vector-mnemonic vec) | |
258 ?-))) | |
259 | |
260 ;; Return docstring of CODING-SYSTEM. | |
261 (defun coding-system-docstring (coding-system) | |
17094
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
262 (check-coding-system coding-system) |
17052 | 263 (let ((vec (coding-system-vector coding-system))) |
264 (if vec (coding-vector-docstring vec)))) | |
265 | |
266 ;; Return flags of CODING-SYSTEM. | |
267 (defun coding-system-flags (coding-system) | |
17094
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
268 (check-coding-system coding-system) |
17052 | 269 (let ((vec (coding-system-vector coding-system))) |
270 (if vec (coding-vector-flags vec)))) | |
271 | |
272 ;; Return eol-type of CODING-SYSTEM. | |
273 (defun coding-system-eoltype (coding-system) | |
17094
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
274 (check-coding-system coding-system) |
17052 | 275 (and coding-system |
276 (or (get coding-system 'eol-type) | |
277 (coding-system-eoltype (get coding-system 'coding-system))))) | |
278 | |
279 ;; Return mnemonic character of eol-type of CODING-SYSTEM. | |
280 (defun coding-system-eoltype-mnemonic (coding-system) | |
281 (let ((eol-type (coding-system-eoltype coding-system))) | |
282 (cond ((vectorp eol-type) eol-mnemonic-undecided) | |
283 ((eq eol-type 0) eol-mnemonic-unix) | |
284 ((eq eol-type 1) eol-mnemonic-unix) | |
285 ((eq eol-type 2) eol-mnemonic-unix) | |
286 (t ?-)))) | |
287 | |
288 ;; Return function for post-read-conversion of CODING-SYSTEM. | |
289 (defun coding-system-post-read-conversion (coding-system) | |
290 (and coding-system | |
291 (symbolp coding-system) | |
292 (or (get coding-system 'post-read-conversion) | |
293 (coding-system-post-read-conversion | |
294 (get coding-system 'coding-system))))) | |
295 | |
296 ;; Return function for pre-write-conversion of CODING-SYSTEM. | |
297 (defun coding-system-pre-write-conversion (coding-system) | |
298 (and coding-system | |
299 (symbolp coding-system) | |
300 (or (get coding-system 'pre-write-conversion) | |
301 (coding-system-pre-write-conversion | |
302 (get coding-system 'coding-system))))) | |
303 | |
304 (defun make-coding-system (coding-system type mnemonic docstring | |
305 &optional flags) | |
306 "Define a new CODING-SYSTEM (symbol). | |
307 Remaining arguments are TYPE, MNEMONIC, DOCSTRING, and FLAGS (optional). | |
308 TYPE is an integer value indicating the type of coding-system as follows: | |
309 0: Emacs internal format, | |
310 1: Shift-JIS (or MS-Kanji) used mainly on Japanese PC, | |
311 2: ISO-2022 including many variants, | |
312 3: Big5 used mainly on Chinese PC, | |
313 4: private, CCL programs provide encoding/decoding algorithm. | |
314 MNEMONIC is a character to be displayed on mode line for the coding-system. | |
315 DOCSTRING is a documentation string for the coding-system. | |
316 FLAGS specifies more precise information of each TYPE. | |
317 If TYPE is 2 (ISO-2022), FLAGS should be a list of: | |
318 CHARSET0, CHARSET1, CHARSET2, CHARSET3, SHORT-FORM, | |
319 ASCII-EOL, ASCII-CNTL, SEVEN, LOCKING-SHIFT, SINGLE-SHIFT, | |
17761
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
320 USE-ROMAN, USE-OLDJIS, NO-ISO6429, INIT-BOL, DESIGNATION-BOL. |
17052 | 321 CHARSETn are character sets initially designated to Gn graphic registers. |
322 If CHARSETn is nil, Gn is never used. | |
323 If CHARSETn is t, Gn can be used but nothing designated initially. | |
324 If CHARSETn is a list of character sets, those character sets are | |
325 designated to Gn on output, but nothing designated to Gn initially. | |
326 SHORT-FORM non-nil means use short designation sequence on output. | |
327 ASCII-EOL non-nil means designate ASCII to g0 at end of line on output. | |
328 ASCII-CNTL non-nil means designate ASCII to g0 before control codes and | |
329 SPACE on output. | |
330 SEVEN non-nil means use 7-bit code only on output. | |
331 LOCKING-SHIFT non-nil means use locking-shift. | |
332 SINGLE-SHIFT non-nil means use single-shift. | |
333 USE-ROMAN non-nil means designate JIS0201-1976-Roman instead of ASCII. | |
334 USE-OLDJIS non-nil means designate JIS0208-1976 instead of JIS0208-1983. | |
335 NO-ISO6429 non-nil means not use ISO6429's direction specification. | |
17094
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
336 INIT-BOL non-nil means any designation state is assumed to be reset |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
337 to initial at each beginning of line on output. |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
338 DESIGNATION-BOL non-nil means designation sequences should be placed |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
339 at beginning of line on output. |
17052 | 340 If TYPE is 4 (private), FLAGS should be a cons of CCL programs, |
341 for encoding and decoding. See the documentation of CCL for more detail." | |
342 | |
343 ;; At first, set a value of `coding-system' property. | |
344 (let ((coding-vector (make-vector 5 nil))) | |
345 (aset coding-vector 0 type) | |
346 (aset coding-vector 1 | |
347 ;; MNEMONIC must be a printable character. | |
348 (if (and (> mnemonic ? ) (< mnemonic 127)) mnemonic ? )) | |
349 (aset coding-vector 2 (if (stringp docstring) docstring "")) | |
350 (aset coding-vector 3 nil) ; obsolete element | |
351 (cond ((eq type 2) ; ISO2022 | |
352 (let ((i 0) | |
353 (vec (make-vector 32 nil))) | |
354 (while (< i 4) | |
355 (let ((charset (car flags))) | |
17094
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
356 (or (not charset) (eq charset t) (charsetp charset) |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
357 (if (not (listp charset)) |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
358 (error "Invalid charset: %s" charset) |
17052 | 359 (let (elt l) |
360 (while charset | |
361 (setq elt (car charset)) | |
17094
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
362 (or (not elt) (eq elt t) (charsetp elt) |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
363 (error "Invalid charset: %s" elt)) |
17052 | 364 (setq l (cons elt l)) |
365 (setq charset (cdr charset))) | |
366 (setq charset (nreverse l))))) | |
367 (aset vec i charset)) | |
368 (setq flags (cdr flags) i (1+ i))) | |
369 (while (and (< i 32) flags) | |
370 (aset vec i (car flags)) | |
371 (setq flags (cdr flags) i (1+ i))) | |
372 (aset coding-vector 4 vec))) | |
373 ((eq type 4) ; private | |
374 (if (and (consp flags) | |
375 (vectorp (car flags)) | |
376 (vectorp (cdr flags))) | |
377 (aset coding-vector 4 flags) | |
378 (error "Invalid FLAGS argument for TYPE 4 (CCL)"))) | |
379 (t (aset coding-vector 4 flags))) | |
380 (put coding-system 'coding-system coding-vector)) | |
381 | |
382 ;; Next, set a value of `eol-type' property. The value is a vector | |
383 ;; of subsidiary coding-systems, each corresponds to a coding-system | |
384 ;; for the detected end-of-line format. | |
385 (let ((codings (vector (intern (format "%s-unix" coding-system)) | |
386 (intern (format "%s-dos" coding-system)) | |
387 (intern (format "%s-mac" coding-system)))) | |
388 (i 0)) | |
389 (while (< i 3) | |
390 (put (aref codings i) 'coding-system coding-system) | |
391 (put (aref codings i) 'eol-type i) | |
392 (setq i (1+ i))) | |
393 (put coding-system 'eol-type codings)) | |
394 ) | |
395 | |
396 (defun define-coding-system-alias (symbol new-symbol) | |
397 "Define NEW-SYMBOL as the same coding system as SYMBOL." | |
398 (check-coding-system symbol) | |
17094
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
399 (put new-symbol 'coding-system symbol) |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
400 (let ((eol-type (coding-system-eoltype symbol))) |
17052 | 401 (if (vectorp eol-type) |
402 (let* ((name (symbol-name new-symbol)) | |
17094
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
403 (new-eol-type (vector (intern (concat name "-unix")) |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
404 (intern (concat name "-dos")) |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
405 (intern (concat name "-mac"))))) |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
406 (define-coding-system-alias (aref eol-type 0) (aref new-eol-type 0)) |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
407 (define-coding-system-alias (aref eol-type 1) (aref new-eol-type 1)) |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
408 (define-coding-system-alias (aref eol-type 2) (aref new-eol-type 2)) |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
409 (setq eol-type new-eol-type))) |
17052 | 410 (put new-symbol 'eol-type eol-type))) |
411 | |
412 (defvar buffer-file-coding-system nil | |
413 "Coding-system of the file which the current-buffer is visiting.") | |
414 (make-variable-buffer-local 'buffer-file-coding-system) | |
415 ;; This value should not be reset by changing major mode. | |
416 (put 'buffer-file-coding-system 'permanent-local t) | |
417 | |
418 (defun set-buffer-file-coding-system (coding-system &optional force) | |
419 "Set buffer-file-coding-system of the current buffer to CODING-SYSTEM. | |
420 If eol-type of the current buffer-file-coding-system is an integer value N, and | |
17761
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
421 eol-type of CODING-SYSTEM is a vector, the Nth element of the vector is used |
17052 | 422 instead of CODING-SYSTEM itself. |
423 Optional prefix argument FORCE non-nil means CODING-SYSTEM is set | |
424 regardless of eol-type of the current buffer-file-coding-system." | |
425 (interactive "zBuffer-file-coding-system: \nP") | |
426 (check-coding-system coding-system) | |
427 (if (null force) | |
428 (let ((x (coding-system-eoltype buffer-file-coding-system)) | |
429 (y (coding-system-eoltype coding-system))) | |
430 (if (and (numberp x) (>= x 0) (<= x 2) (vectorp y)) | |
431 (setq coding-system (aref y x))))) | |
432 (setq buffer-file-coding-system coding-system) | |
433 (set-buffer-modified-p t) | |
434 (force-mode-line-update)) | |
435 | |
436 (defun set-current-process-coding-system (input output) | |
437 (interactive | |
438 "zCoding-system for process input: \nzCoding-system for process output: ") | |
439 (let ((proc (get-buffer-process (current-buffer)))) | |
440 (if (null proc) | |
441 (error "no process") | |
442 (check-coding-system input) | |
443 (check-coding-system output) | |
444 (set-process-coding-system proc input output))) | |
445 (force-mode-line-update)) | |
446 | |
447 (defvar default-process-coding-system (cons nil nil) | |
448 "Cons of default values used to read from and write to process.") | |
449 | |
450 (defun set-coding-priority (arg) | |
451 "Set priority of coding-category according to LIST. | |
452 LIST is a list of coding-categories ordered by priority." | |
453 (let (l) | |
454 ;; Put coding-categories listed in ARG to L while checking the | |
455 ;; validity. We assume that `coding-category-list' contains whole | |
456 ;; coding-categories. | |
457 (while arg | |
458 (if (null (memq (car arg) coding-category-list)) | |
459 (error "Invalid element in argument: %s" (car arg))) | |
460 (setq l (cons (car arg) l)) | |
461 (setq arg (cdr arg))) | |
462 ;; Put coding-category not listed in ARG to L. | |
463 (while coding-category-list | |
464 (if (null (memq (car coding-category-list) l)) | |
465 (setq l (cons (car coding-category-list) l))) | |
466 (setq coding-category-list (cdr coding-category-list))) | |
467 ;; Update `coding-category-list' and return it. | |
468 (setq coding-category-list (nreverse l)))) | |
469 | |
470 ;;; FILE I/O | |
471 | |
472 ;; Set buffer-file-coding-system of the current buffer after some text | |
473 ;; is inserted. | |
474 (defun after-insert-file-set-buffer-file-coding-system (inserted) | |
475 (if last-coding-system-used | |
476 (let ((coding-system | |
477 (find-new-buffer-file-coding-system last-coding-system-used)) | |
478 (modified-p (buffer-modified-p))) | |
479 (if coding-system | |
480 (set-buffer-file-coding-system coding-system)) | |
481 (set-buffer-modified-p modified-p))) | |
482 nil) | |
483 | |
484 (setq after-insert-file-functions | |
485 (cons 'after-insert-file-set-buffer-file-coding-system | |
486 after-insert-file-functions)) | |
487 | |
488 ;; The coding-vector and eol-type of coding-system returned is decided | |
489 ;; independently in the following order. | |
490 ;; 1. That of buffer-file-coding-system locally bound. | |
491 ;; 2. That of CODING. | |
492 | |
493 (defun find-new-buffer-file-coding-system (coding) | |
494 "Return a coding system for a buffer when a file of CODING is inserted. | |
17761
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
495 The local variable `buffer-file-coding-system' of the current buffer |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
496 is set to the returned value. |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
497 Return nil if there's no need of setting new buffer-file-coding-system." |
17052 | 498 (let (local-coding local-eol |
499 found-eol | |
500 new-coding new-eol) | |
501 (if (null coding) | |
502 ;; Nothing found about coding. | |
503 nil | |
504 | |
505 ;; Get information of the current local value of | |
506 ;; `buffer-file-coding-system' in LOCAL-EOL and LOCAL-CODING. | |
507 (if (local-variable-p 'buffer-file-coding-system) | |
508 ;; Something already set locally. | |
509 (progn | |
510 (setq local-eol (coding-system-eoltype buffer-file-coding-system)) | |
511 (if (null (numberp local-eol)) | |
512 ;; But eol-type is not yet set. | |
513 (setq local-eol nil)) | |
514 (if (null (eq (coding-system-type buffer-file-coding-system) t)) | |
515 ;; This is not automatic-conversion. | |
516 (progn | |
517 (setq local-coding buffer-file-coding-system) | |
518 (while (symbolp (get local-coding 'coding-system)) | |
519 (setq local-coding (get local-coding 'coding-system)))) | |
520 ))) | |
521 | |
522 (if (and local-eol local-coding) | |
523 ;; The current buffer has already set full coding-system, we | |
524 ;; had better not change it. | |
525 nil | |
526 | |
527 (setq found-eol (coding-system-eoltype coding)) | |
528 (if (null (numberp found-eol)) | |
529 ;; But eol-type is not found. | |
530 (setq found-eol nil)) | |
531 (if (eq (coding-system-type coding) t) | |
532 ;; This is automatic-conversion, which means nothing found | |
533 ;; except for eol-type. | |
534 (setq coding nil)) | |
535 | |
536 ;; The local setting takes precedence over the found one. | |
537 (setq new-coding (or local-coding coding)) | |
538 (setq new-eol (or local-eol found-eol)) | |
539 (if (and (numberp new-eol) | |
540 (vectorp (coding-system-eoltype new-coding))) | |
541 (setq new-coding | |
542 (aref (coding-system-eoltype new-coding) new-eol))) | |
543 new-coding)))) | |
544 | |
17761
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
545 (defun make-unification-table (&rest args) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
546 "Make a unification table (char table) from arguments. |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
547 Each argument is a list of cons cells of characters. |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
548 While unifying characters in the unification table, a character of |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
549 the car part is unified to a character of the corresponding cdr part. |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
550 |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
551 A characters can be a generic characters (see make-char). In this case, |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
552 all characters belonging to a generic character of the car part |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
553 are unified to characters beloging to a generic characters of the |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
554 corresponding cdr part without changing their position code(s)." |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
555 (let ((table (make-char-table 'character-unification-table)) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
556 revlist) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
557 (while args |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
558 (let ((elts (car args))) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
559 (while elts |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
560 (let ((from (car (car elts))) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
561 (to (cdr (car elts)))) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
562 (if (or (not (integerp from)) (not (integerp to))) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
563 (error "Invalid character pair (%s . %s)" from to)) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
564 ;; If we have already unified TO to some char, FROM should |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
565 ;; also be unified to the same char. |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
566 (setq to (or (aref table to) to)) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
567 (aset table from to) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
568 ;; If we have already unified some chars to FROM, they |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
569 ;; should also be unified to TO. |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
570 (let ((l (assq from revlist))) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
571 (if l |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
572 (let ((ch (car l))) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
573 (setcar l to) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
574 (setq l (cdr l)) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
575 (while l |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
576 (aset table ch to) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
577 (setq l (cdr l)) )))) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
578 ;; Now update REVLIST. |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
579 (let ((l (assq to revlist))) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
580 (if l |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
581 (setcdr l (cons from (cdr l))) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
582 (setq revlist (cons (list to from) revlist))))) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
583 (setq elts (cdr elts)))) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
584 (setq args (cdr args))) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
585 ;; Return TABLE just created. |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
586 table)) |
c5f430853301
(make-char): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
17175
diff
changeset
|
587 |
17094
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
588 ;;; Initialize some variables. |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
589 |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
590 (put 'use-default-ascent 'char-table-extra-slots 0) |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
591 (setq use-default-ascent (make-char-table 'use-default-ascent)) |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
592 |
c237252970e5
(make-coding-system): For ISO-2022 type conding systems,
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
593 ;;; |
17052 | 594 (provide 'mule) |
595 | |
596 ;;; mule.el ends here |