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