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)
|
|
187 (aref (charset-info (nth 1 charset)) 14)
|
|
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)
|
|
194 (if (quoted-symbol-p charset)
|
|
195 `(make-char-internal ,(charset-id (nth 1 charset)) ,c1 ,c2)
|
|
196 `(make-char-internal (charset-id ,charset) ,c1 ,c2)))
|
|
197
|
|
198 ;; Coding-system staffs
|
|
199
|
|
200 ;; Coding-system object is a symbol that has the property
|
|
201 ;; `coding-system' and `eol-type'.
|
|
202 ;;
|
|
203 ;; The value of the property `coding-system' is a coding-vector of the
|
|
204 ;; format: [TYPE MNEMONIC DOCSTRING NOT-USED-NOW FLAGS].
|
|
205 ;; See comments in src/coding.c for more detail. The property value
|
|
206 ;; may be another coding-system, in which case, the coding-vector
|
|
207 ;; should be taken from that coding-system.
|
|
208 ;;
|
|
209 ;; The value of the property `eol-type' is integer 0..2 or a vector of
|
|
210 ;; length 3. The integer value 0, 1, and 2 indicate the format of
|
|
211 ;; end-of-line LF, CRLF, and CR respectively. The vector value
|
|
212 ;; indicates that the format of end-of-line should be detected
|
|
213 ;; automatically. Nth element of the vector is the subsidiary
|
|
214 ;; coding-system whose `eol-type' property is integer value.
|
|
215 ;;
|
|
216 ;; Coding-system may also have properties `post-read-conversion' and
|
|
217 ;; `pre-write-conversion and the values are functions.
|
|
218 ;;
|
|
219 ;; The function in `post-read-conversion' is called after some text is
|
|
220 ;; inserted and decoded along the coding-system and before any
|
|
221 ;; functions in `after-insert-functions' are called. The arguments to
|
|
222 ;; this function is the same as those of a function in
|
|
223 ;; `after-insert-functions', i.e. LENGTH of a text while putting point
|
|
224 ;; at the head of the text to be decoded
|
|
225 ;;
|
|
226 ;; The function in `pre-write-conversion' is called after all
|
|
227 ;; functions in `write-region-annotate-functions' and
|
|
228 ;; `buffer-file-format' are called, and before the text is encoded by
|
|
229 ;; the coding-system. The arguments to this function is the same as
|
|
230 ;; those of a function in `write-region-annotate-functions', i.e. FROM
|
|
231 ;; and TO specifying region of a text.
|
|
232
|
|
233 (defsubst coding-vector-type (vec) (aref vec 0))
|
|
234 (defsubst coding-vector-mnemonic (vec) (aref vec 1))
|
|
235 (defsubst coding-vector-docstring (vec) (aref vec 2))
|
|
236 (defsubst coding-vector-flags (vec) (aref vec 4))
|
|
237
|
|
238 ;; Return type of CODING-SYSTEM.
|
|
239 (defun coding-system-type (coding-system)
|
|
240 (let ((vec (coding-system-vector coding-system)))
|
|
241 (if vec (coding-vector-type vec))))
|
|
242
|
|
243 ;; Return mnemonic character of CODING-SYSTEM.
|
|
244 (defun coding-system-mnemonic (coding-system)
|
|
245 (let ((vec (coding-system-vector coding-system)))
|
|
246 (if vec (coding-vector-mnemonic vec)
|
|
247 ?-)))
|
|
248
|
|
249 ;; Return docstring of CODING-SYSTEM.
|
|
250 (defun coding-system-docstring (coding-system)
|
|
251 (let ((vec (coding-system-vector coding-system)))
|
|
252 (if vec (coding-vector-docstring vec))))
|
|
253
|
|
254 ;; Return flags of CODING-SYSTEM.
|
|
255 (defun coding-system-flags (coding-system)
|
|
256 (let ((vec (coding-system-vector coding-system)))
|
|
257 (if vec (coding-vector-flags vec))))
|
|
258
|
|
259 ;; Return eol-type of CODING-SYSTEM.
|
|
260 (defun coding-system-eoltype (coding-system)
|
|
261 (and coding-system
|
|
262 (or (get coding-system 'eol-type)
|
|
263 (coding-system-eoltype (get coding-system 'coding-system)))))
|
|
264
|
|
265 ;; Return mnemonic character of eol-type of CODING-SYSTEM.
|
|
266 (defun coding-system-eoltype-mnemonic (coding-system)
|
|
267 (let ((eol-type (coding-system-eoltype coding-system)))
|
|
268 (cond ((vectorp eol-type) eol-mnemonic-undecided)
|
|
269 ((eq eol-type 0) eol-mnemonic-unix)
|
|
270 ((eq eol-type 1) eol-mnemonic-unix)
|
|
271 ((eq eol-type 2) eol-mnemonic-unix)
|
|
272 (t ?-))))
|
|
273
|
|
274 ;; Return function for post-read-conversion of CODING-SYSTEM.
|
|
275 (defun coding-system-post-read-conversion (coding-system)
|
|
276 (and coding-system
|
|
277 (symbolp coding-system)
|
|
278 (or (get coding-system 'post-read-conversion)
|
|
279 (coding-system-post-read-conversion
|
|
280 (get coding-system 'coding-system)))))
|
|
281
|
|
282 ;; Return function for pre-write-conversion of CODING-SYSTEM.
|
|
283 (defun coding-system-pre-write-conversion (coding-system)
|
|
284 (and coding-system
|
|
285 (symbolp coding-system)
|
|
286 (or (get coding-system 'pre-write-conversion)
|
|
287 (coding-system-pre-write-conversion
|
|
288 (get coding-system 'coding-system)))))
|
|
289
|
|
290 (defun make-coding-system (coding-system type mnemonic docstring
|
|
291 &optional flags)
|
|
292 "Define a new CODING-SYSTEM (symbol).
|
|
293 Remaining arguments are TYPE, MNEMONIC, DOCSTRING, and FLAGS (optional).
|
|
294 TYPE is an integer value indicating the type of coding-system as follows:
|
|
295 0: Emacs internal format,
|
|
296 1: Shift-JIS (or MS-Kanji) used mainly on Japanese PC,
|
|
297 2: ISO-2022 including many variants,
|
|
298 3: Big5 used mainly on Chinese PC,
|
|
299 4: private, CCL programs provide encoding/decoding algorithm.
|
|
300 MNEMONIC is a character to be displayed on mode line for the coding-system.
|
|
301 DOCSTRING is a documentation string for the coding-system.
|
|
302 FLAGS specifies more precise information of each TYPE.
|
|
303 If TYPE is 2 (ISO-2022), FLAGS should be a list of:
|
|
304 CHARSET0, CHARSET1, CHARSET2, CHARSET3, SHORT-FORM,
|
|
305 ASCII-EOL, ASCII-CNTL, SEVEN, LOCKING-SHIFT, SINGLE-SHIFT,
|
|
306 USE-ROMAN, USE-OLDJIS, NO-ISO6429.
|
|
307 CHARSETn are character sets initially designated to Gn graphic registers.
|
|
308 If CHARSETn is nil, Gn is never used.
|
|
309 If CHARSETn is t, Gn can be used but nothing designated initially.
|
|
310 If CHARSETn is a list of character sets, those character sets are
|
|
311 designated to Gn on output, but nothing designated to Gn initially.
|
|
312 SHORT-FORM non-nil means use short designation sequence on output.
|
|
313 ASCII-EOL non-nil means designate ASCII to g0 at end of line on output.
|
|
314 ASCII-CNTL non-nil means designate ASCII to g0 before control codes and
|
|
315 SPACE on output.
|
|
316 SEVEN non-nil means use 7-bit code only on output.
|
|
317 LOCKING-SHIFT non-nil means use locking-shift.
|
|
318 SINGLE-SHIFT non-nil means use single-shift.
|
|
319 USE-ROMAN non-nil means designate JIS0201-1976-Roman instead of ASCII.
|
|
320 USE-OLDJIS non-nil means designate JIS0208-1976 instead of JIS0208-1983.
|
|
321 NO-ISO6429 non-nil means not use ISO6429's direction specification.
|
|
322 If TYPE is 4 (private), FLAGS should be a cons of CCL programs,
|
|
323 for encoding and decoding. See the documentation of CCL for more detail."
|
|
324
|
|
325 ;; At first, set a value of `coding-system' property.
|
|
326 (let ((coding-vector (make-vector 5 nil)))
|
|
327 (aset coding-vector 0 type)
|
|
328 (aset coding-vector 1
|
|
329 ;; MNEMONIC must be a printable character.
|
|
330 (if (and (> mnemonic ? ) (< mnemonic 127)) mnemonic ? ))
|
|
331 (aset coding-vector 2 (if (stringp docstring) docstring ""))
|
|
332 (aset coding-vector 3 nil) ; obsolete element
|
|
333 (cond ((eq type 2) ; ISO2022
|
|
334 (let ((i 0)
|
|
335 (vec (make-vector 32 nil)))
|
|
336 (while (< i 4)
|
|
337 (let ((charset (car flags)))
|
|
338 (if (and charset (not (eq charset t)))
|
|
339 (if (symbolp charset)
|
|
340 (setq charset (charset-id charset))
|
|
341 (let (elt l)
|
|
342 (while charset
|
|
343 (setq elt (car charset))
|
|
344 (if (and elt (not (eq elt t)))
|
|
345 (setq elt (charset-id elt)))
|
|
346 (setq l (cons elt l))
|
|
347 (setq charset (cdr charset)))
|
|
348 (setq charset (nreverse l)))))
|
|
349 (aset vec i charset))
|
|
350 (setq flags (cdr flags) i (1+ i)))
|
|
351 (while (and (< i 32) flags)
|
|
352 (aset vec i (car flags))
|
|
353 (setq flags (cdr flags) i (1+ i)))
|
|
354 (aset coding-vector 4 vec)))
|
|
355 ((eq type 4) ; private
|
|
356 (if (and (consp flags)
|
|
357 (vectorp (car flags))
|
|
358 (vectorp (cdr flags)))
|
|
359 (aset coding-vector 4 flags)
|
|
360 (error "Invalid FLAGS argument for TYPE 4 (CCL)")))
|
|
361 (t (aset coding-vector 4 flags)))
|
|
362 (put coding-system 'coding-system coding-vector))
|
|
363
|
|
364 ;; Next, set a value of `eol-type' property. The value is a vector
|
|
365 ;; of subsidiary coding-systems, each corresponds to a coding-system
|
|
366 ;; for the detected end-of-line format.
|
|
367 (let ((codings (vector (intern (format "%s-unix" coding-system))
|
|
368 (intern (format "%s-dos" coding-system))
|
|
369 (intern (format "%s-mac" coding-system))))
|
|
370 (i 0))
|
|
371 (while (< i 3)
|
|
372 (put (aref codings i) 'coding-system coding-system)
|
|
373 (put (aref codings i) 'eol-type i)
|
|
374 (setq i (1+ i)))
|
|
375 (put coding-system 'eol-type codings))
|
|
376 )
|
|
377
|
|
378 (defun define-coding-system-alias (symbol new-symbol)
|
|
379 "Define NEW-SYMBOL as the same coding system as SYMBOL."
|
|
380 (check-coding-system symbol)
|
|
381 (put new-symbol 'coding-system (get symbol 'coding-system))
|
|
382 (let ((eol-type (get symbol 'eol-type)))
|
|
383 (if (vectorp eol-type)
|
|
384 (let* ((name (symbol-name new-symbol))
|
|
385 (new (vector (intern (concat name "-unix"))
|
|
386 (intern (concat name "-dos"))
|
|
387 (intern (concat name "-mac"))))
|
|
388 (i 0))
|
|
389 (while (< i 3)
|
|
390 (define-coding-system-alias (aref eol-type i) (aref new i))
|
|
391 (setq i (1+ i)))
|
|
392 (setq eol-type new)))
|
|
393 (put new-symbol 'eol-type eol-type)))
|
|
394
|
|
395 (defvar buffer-file-coding-system nil
|
|
396 "Coding-system of the file which the current-buffer is visiting.")
|
|
397 (make-variable-buffer-local 'buffer-file-coding-system)
|
|
398 ;; This value should not be reset by changing major mode.
|
|
399 (put 'buffer-file-coding-system 'permanent-local t)
|
|
400
|
|
401 (defun set-buffer-file-coding-system (coding-system &optional force)
|
|
402 "Set buffer-file-coding-system of the current buffer to CODING-SYSTEM.
|
|
403 If eol-type of the current buffer-file-coding-system is an integer value N, and
|
|
404 eol-type of CODING-SYSTEM is a vector, the Nth element of the vector is set
|
|
405 instead of CODING-SYSTEM itself.
|
|
406 Optional prefix argument FORCE non-nil means CODING-SYSTEM is set
|
|
407 regardless of eol-type of the current buffer-file-coding-system."
|
|
408 (interactive "zBuffer-file-coding-system: \nP")
|
|
409 (check-coding-system coding-system)
|
|
410 (if (null force)
|
|
411 (let ((x (coding-system-eoltype buffer-file-coding-system))
|
|
412 (y (coding-system-eoltype coding-system)))
|
|
413 (if (and (numberp x) (>= x 0) (<= x 2) (vectorp y))
|
|
414 (setq coding-system (aref y x)))))
|
|
415 (setq buffer-file-coding-system coding-system)
|
|
416 (set-buffer-modified-p t)
|
|
417 (force-mode-line-update))
|
|
418
|
|
419 (defun set-current-process-coding-system (input output)
|
|
420 (interactive
|
|
421 "zCoding-system for process input: \nzCoding-system for process output: ")
|
|
422 (let ((proc (get-buffer-process (current-buffer))))
|
|
423 (if (null proc)
|
|
424 (error "no process")
|
|
425 (check-coding-system input)
|
|
426 (check-coding-system output)
|
|
427 (set-process-coding-system proc input output)))
|
|
428 (force-mode-line-update))
|
|
429
|
|
430 (defvar default-process-coding-system (cons nil nil)
|
|
431 "Cons of default values used to read from and write to process.")
|
|
432
|
|
433 (defun set-coding-priority (arg)
|
|
434 "Set priority of coding-category according to LIST.
|
|
435 LIST is a list of coding-categories ordered by priority."
|
|
436 (let (l)
|
|
437 ;; Put coding-categories listed in ARG to L while checking the
|
|
438 ;; validity. We assume that `coding-category-list' contains whole
|
|
439 ;; coding-categories.
|
|
440 (while arg
|
|
441 (if (null (memq (car arg) coding-category-list))
|
|
442 (error "Invalid element in argument: %s" (car arg)))
|
|
443 (setq l (cons (car arg) l))
|
|
444 (setq arg (cdr arg)))
|
|
445 ;; Put coding-category not listed in ARG to L.
|
|
446 (while coding-category-list
|
|
447 (if (null (memq (car coding-category-list) l))
|
|
448 (setq l (cons (car coding-category-list) l)))
|
|
449 (setq coding-category-list (cdr coding-category-list)))
|
|
450 ;; Update `coding-category-list' and return it.
|
|
451 (setq coding-category-list (nreverse l))))
|
|
452
|
|
453 ;;; FILE I/O
|
|
454
|
|
455 ;; Set buffer-file-coding-system of the current buffer after some text
|
|
456 ;; is inserted.
|
|
457 (defun after-insert-file-set-buffer-file-coding-system (inserted)
|
|
458 (if last-coding-system-used
|
|
459 (let ((coding-system
|
|
460 (find-new-buffer-file-coding-system last-coding-system-used))
|
|
461 (modified-p (buffer-modified-p)))
|
|
462 (if coding-system
|
|
463 (set-buffer-file-coding-system coding-system))
|
|
464 (set-buffer-modified-p modified-p)))
|
|
465 nil)
|
|
466
|
|
467 (setq after-insert-file-functions
|
|
468 (cons 'after-insert-file-set-buffer-file-coding-system
|
|
469 after-insert-file-functions))
|
|
470
|
|
471 ;; The coding-vector and eol-type of coding-system returned is decided
|
|
472 ;; independently in the following order.
|
|
473 ;; 1. That of buffer-file-coding-system locally bound.
|
|
474 ;; 2. That of CODING.
|
|
475
|
|
476 (defun find-new-buffer-file-coding-system (coding)
|
|
477 "Return a coding system for a buffer when a file of CODING is inserted.
|
|
478 The returned value is set to `buffer-file-coding-system' of the
|
|
479 current buffer. Return nil if there's no need of setting new
|
|
480 buffer-file-coding-system."
|
|
481 (let (local-coding local-eol
|
|
482 found-eol
|
|
483 new-coding new-eol)
|
|
484 (if (null coding)
|
|
485 ;; Nothing found about coding.
|
|
486 nil
|
|
487
|
|
488 ;; Get information of the current local value of
|
|
489 ;; `buffer-file-coding-system' in LOCAL-EOL and LOCAL-CODING.
|
|
490 (if (local-variable-p 'buffer-file-coding-system)
|
|
491 ;; Something already set locally.
|
|
492 (progn
|
|
493 (setq local-eol (coding-system-eoltype buffer-file-coding-system))
|
|
494 (if (null (numberp local-eol))
|
|
495 ;; But eol-type is not yet set.
|
|
496 (setq local-eol nil))
|
|
497 (if (null (eq (coding-system-type buffer-file-coding-system) t))
|
|
498 ;; This is not automatic-conversion.
|
|
499 (progn
|
|
500 (setq local-coding buffer-file-coding-system)
|
|
501 (while (symbolp (get local-coding 'coding-system))
|
|
502 (setq local-coding (get local-coding 'coding-system))))
|
|
503 )))
|
|
504
|
|
505 (if (and local-eol local-coding)
|
|
506 ;; The current buffer has already set full coding-system, we
|
|
507 ;; had better not change it.
|
|
508 nil
|
|
509
|
|
510 (setq found-eol (coding-system-eoltype coding))
|
|
511 (if (null (numberp found-eol))
|
|
512 ;; But eol-type is not found.
|
|
513 (setq found-eol nil))
|
|
514 (if (eq (coding-system-type coding) t)
|
|
515 ;; This is automatic-conversion, which means nothing found
|
|
516 ;; except for eol-type.
|
|
517 (setq coding nil))
|
|
518
|
|
519 ;; The local setting takes precedence over the found one.
|
|
520 (setq new-coding (or local-coding coding))
|
|
521 (setq new-eol (or local-eol found-eol))
|
|
522 (if (and (numberp new-eol)
|
|
523 (vectorp (coding-system-eoltype new-coding)))
|
|
524 (setq new-coding
|
|
525 (aref (coding-system-eoltype new-coding) new-eol)))
|
|
526 new-coding))))
|
|
527
|
|
528 (provide 'mule)
|
|
529
|
|
530 ;;; mule.el ends here
|