Commit | Line | Data |
---|---|---|
4ed46869 KH |
1 | ;;; mule-cmds.el --- Commands for mulitilingual environment |
2 | ||
4ed46869 | 3 | ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. |
fa526c4a | 4 | ;; Licensed to the Free Software Foundation. |
4ed46869 KH |
5 | |
6 | ;; Keywords: mule, multilingual | |
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 | |
369314dc KH |
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. | |
4ed46869 KH |
24 | |
25 | ;;; Code: | |
26 | ||
27 | ;;; MULE related key bindings and menus. | |
28 | ||
0709d285 | 29 | (defvar mule-keymap (make-sparse-keymap) |
4ed46869 | 30 | "Keymap for MULE (Multilingual environment) specific commands.") |
4ed46869 | 31 | |
8f81f784 | 32 | ;; Keep "C-x C-m ..." for mule specific commands. |
0709d285 | 33 | (define-key ctl-x-map "\C-m" mule-keymap) |
ef8a8c8c | 34 | |
4ed46869 KH |
35 | (define-key mule-keymap "f" 'set-buffer-file-coding-system) |
36 | (define-key mule-keymap "t" 'set-terminal-coding-system) | |
15b3e511 KH |
37 | (define-key mule-keymap "k" 'set-keyboard-coding-system) |
38 | (define-key mule-keymap "p" 'set-buffer-process-coding-system) | |
8b784951 | 39 | (define-key mule-keymap "\C-\\" 'set-input-method) |
15b3e511 | 40 | (define-key mule-keymap "c" 'universal-coding-system-argument) |
b4fba33f | 41 | (define-key mule-keymap "l" 'set-language-environment) |
4ed46869 | 42 | |
281d03ec | 43 | (define-key help-map "\C-L" 'describe-language-environment) |
ac4a3a2d | 44 | (define-key help-map "L" 'describe-language-environment) |
4ed46869 | 45 | (define-key help-map "\C-\\" 'describe-input-method) |
ac4a3a2d | 46 | (define-key help-map "I" 'describe-input-method) |
d0b9c3ab | 47 | (define-key help-map "C" 'describe-coding-system) |
4ed46869 KH |
48 | (define-key help-map "h" 'view-hello-file) |
49 | ||
0709d285 | 50 | (defvar mule-menu-keymap (make-sparse-keymap "Mule") |
15b3e511 | 51 | "Keymap for MULE (Multilingual environment) menu specific commands.") |
15b3e511 | 52 | |
ef6675c8 RS |
53 | (define-key global-map [menu-bar mule] |
54 | `(menu-item "Mule" ,mule-menu-keymap | |
55 | :visible default-enable-multibyte-characters)) | |
15b3e511 KH |
56 | |
57 | (setq menu-bar-final-items (cons 'mule menu-bar-final-items)) | |
58 | ||
281d03ec RS |
59 | (defvar describe-language-environment-map nil) |
60 | (define-prefix-command 'describe-language-environment-map) | |
15b3e511 KH |
61 | |
62 | (defvar setup-language-environment-map nil) | |
63 | (define-prefix-command 'setup-language-environment-map) | |
64 | ||
65 | (defvar set-coding-system-map nil) | |
66 | (define-prefix-command 'set-coding-system-map) | |
67 | ||
281d03ec | 68 | (define-key-after mule-menu-keymap [describe-language-environment] |
8e02924a | 69 | '("Describe Language Environment" . describe-language-environment-map) |
15b3e511 KH |
70 | t) |
71 | (define-key-after mule-menu-keymap [set-language-environment] | |
8e02924a | 72 | '("Set Language Environment" . setup-language-environment-map) |
15b3e511 | 73 | t) |
a61f401d | 74 | (define-key-after mule-menu-keymap [mouse-set-font] |
8e02924a | 75 | '("Set Font/Fontset" . mouse-set-font) |
a61f401d | 76 | t) |
15b3e511 KH |
77 | (define-key-after mule-menu-keymap [separator-mule] |
78 | '("--") | |
79 | t) | |
80 | (define-key-after mule-menu-keymap [toggle-input-method] | |
8e02924a | 81 | '("Toggle Input Method" . toggle-input-method) |
15b3e511 | 82 | t) |
8b784951 KH |
83 | (define-key-after mule-menu-keymap [set-input-method] |
84 | '("Select Input Method" . set-input-method) | |
15b3e511 KH |
85 | t) |
86 | (define-key-after mule-menu-keymap [describe-input-method] | |
8e02924a | 87 | '("Describe Input Method" . describe-input-method) |
15b3e511 KH |
88 | t) |
89 | (define-key-after mule-menu-keymap [separator-input-method] | |
90 | '("--") | |
91 | t) | |
d0b9c3ab | 92 | (define-key-after mule-menu-keymap [describe-coding-system] |
8e02924a | 93 | '("Describe Coding Systems" . describe-coding-system) |
15b3e511 KH |
94 | t) |
95 | (define-key-after mule-menu-keymap [set-various-coding-system] | |
8e02924a | 96 | '("Set Coding System" . set-coding-system-map) |
15b3e511 KH |
97 | t) |
98 | (define-key-after mule-menu-keymap [separator-coding-system] | |
99 | '("--") | |
100 | t) | |
101 | (define-key-after mule-menu-keymap [mule-diag] | |
8e02924a | 102 | '("Show All of MULE Status" . mule-diag) |
15b3e511 KH |
103 | t) |
104 | (define-key-after mule-menu-keymap [view-hello-file] | |
8e02924a | 105 | '("Show Script Examples" . view-hello-file) |
15b3e511 KH |
106 | t) |
107 | ||
108 | (define-key-after set-coding-system-map [set-buffer-file-coding-system] | |
8e02924a | 109 | '("Buffer File" . set-buffer-file-coding-system) |
15b3e511 | 110 | t) |
3a151e98 RS |
111 | (define-key-after set-coding-system-map [universal-coding-system-argument] |
112 | '("Next Command" . universal-coding-system-argument) | |
113 | t) | |
15b3e511 KH |
114 | (define-key-after set-coding-system-map [set-terminal-coding-system] |
115 | '("Terminal" . set-terminal-coding-system) | |
116 | t) | |
117 | (define-key-after set-coding-system-map [set-keyboard-coding-system] | |
118 | '("Keyboard" . set-keyboard-coding-system) | |
119 | t) | |
120 | (define-key-after set-coding-system-map [set-buffer-process-coding-system] | |
8e02924a | 121 | '("Buffer Process" . set-buffer-process-coding-system) |
15b3e511 KH |
122 | t) |
123 | ||
124 | (define-key setup-language-environment-map | |
125 | [Default] '("Default" . setup-specified-language-environment)) | |
4ed46869 KH |
126 | |
127 | ;; These are meaningless when running under X. | |
4ed46869 | 128 | (put 'set-terminal-coding-system 'menu-enable |
9ba344f7 | 129 | '(not (eq window-system 'x))) |
15b3e511 | 130 | (put 'set-keyboard-coding-system 'menu-enable |
9ba344f7 | 131 | '(not (eq window-system 'x))) |
d0b9c3ab KH |
132 | ;; This is meaningless when the current buffer has no process. |
133 | (put 'set-buffer-process-coding-system 'menu-enable | |
134 | '(get-buffer-process (current-buffer))) | |
4ed46869 | 135 | |
4ed46869 KH |
136 | ;; This should be a single character key binding because users use it |
137 | ;; very frequently while editing multilingual text. Now we can use | |
138 | ;; only two such keys: "\C-\\" and "\C-^", but the latter is not | |
139 | ;; convenient because it requires shifting on most keyboards. An | |
140 | ;; alternative is "\C-\]" which is now bound to `abort-recursive-edit' | |
141 | ;; but it won't be used that frequently. | |
142 | (define-key global-map "\C-\\" 'toggle-input-method) | |
143 | ||
a2ad45b9 RS |
144 | ;;; This is no good because people often type Shift-SPC |
145 | ;;; meaning to type SPC. -- rms. | |
146 | ;;; ;; Here's an alternative key binding for X users (Shift-SPACE). | |
147 | ;;; (define-key global-map [?\S- ] 'toggle-input-method) | |
b4fba33f | 148 | |
4ed46869 | 149 | (defun toggle-enable-multibyte-characters (&optional arg) |
6998e1a1 RS |
150 | "Change whether this buffer uses multibyte characters. |
151 | With arg, use multibyte characters if the arg is positive. | |
152 | ||
153 | Note that this command does not convert the byte contents of | |
154 | the buffer; it only changes the way those bytes are interpreted. | |
155 | In general, therefore, this command *changes* the sequence of | |
156 | characters that the current buffer contains. | |
157 | ||
158 | We suggest you avoid using use this command unless you know what you | |
159 | are doing. If you use it by mistake, and the buffer is now displayed | |
160 | wrong, use this command again to toggle back to the right mode." | |
4ed46869 | 161 | (interactive "P") |
b7079457 RS |
162 | (let ((new-flag |
163 | (if (null arg) (null enable-multibyte-characters) | |
164 | (> (prefix-numeric-value arg) 0)))) | |
165 | (set-buffer-multibyte new-flag)) | |
4ed46869 KH |
166 | (force-mode-line-update)) |
167 | ||
168 | (defun view-hello-file () | |
169 | "Display the HELLO file which list up many languages and characters." | |
170 | (interactive) | |
8f81f784 KH |
171 | ;; We have to decode the file in any environment. |
172 | (let ((default-enable-multibyte-characters t) | |
95fa03b4 | 173 | (coding-system-for-read 'iso-2022-7bit)) |
8f81f784 | 174 | (find-file-read-only (expand-file-name "HELLO" data-directory)))) |
4ed46869 | 175 | |
15b3e511 KH |
176 | (defun universal-coding-system-argument () |
177 | "Execute an I/O command using the specified coding system." | |
178 | (interactive) | |
34104362 KH |
179 | (let* ((default (and buffer-file-coding-system |
180 | (not (eq (coding-system-type buffer-file-coding-system) | |
181 | t)) | |
182 | buffer-file-coding-system)) | |
183 | (coding-system (read-coding-system | |
184 | (if default | |
185 | (format "Coding system for following command (default, %s): " default) | |
186 | "Coding system for following command: ") | |
187 | default)) | |
15b3e511 | 188 | (keyseq (read-key-sequence |
e14a8f4c | 189 | (format "Command to execute with %s:" coding-system))) |
15b3e511 KH |
190 | (cmd (key-binding keyseq))) |
191 | (let ((coding-system-for-read coding-system) | |
192 | (coding-system-for-write coding-system)) | |
193 | (message "") | |
194 | (call-interactively cmd)))) | |
195 | ||
de94d711 | 196 | (defun set-default-coding-systems (coding-system) |
0c3154d2 | 197 | "Set default value of various coding systems to CODING-SYSTEM. |
387136f6 | 198 | This sets the following coding systems: |
0c3154d2 | 199 | o coding system of a newly created buffer |
8efc03e1 KH |
200 | o default coding system for subprocess I/O |
201 | This also sets the following values: | |
387136f6 | 202 | o default value used as file-name-coding-system for converting file names. |
8efc03e1 KH |
203 | o default value for the command `set-terminal-coding-system' |
204 | o default value for the command `set-keyboard-coding-system'" | |
de94d711 KH |
205 | (check-coding-system coding-system) |
206 | (setq-default buffer-file-coding-system coding-system) | |
387136f6 | 207 | (setq default-file-name-coding-system coding-system) |
de94d711 KH |
208 | (setq default-terminal-coding-system coding-system) |
209 | (setq default-keyboard-coding-system coding-system) | |
210 | (setq default-process-coding-system (cons coding-system coding-system))) | |
211 | ||
0c3154d2 KH |
212 | (defun prefer-coding-system (coding-system) |
213 | "Add CODING-SYSTEM at the front of the priority list for automatic detection. | |
387136f6 | 214 | This also sets the following coding systems: |
0c3154d2 | 215 | o coding system of a newly created buffer |
8efc03e1 KH |
216 | o default coding system for subprocess I/O |
217 | This also sets the following values: | |
387136f6 | 218 | o default value used as file-name-coding-system for converting file names. |
8efc03e1 KH |
219 | o default value for the command `set-terminal-coding-system' |
220 | o default value for the command `set-keyboard-coding-system'" | |
0c3154d2 KH |
221 | (interactive "zPrefer coding system: ") |
222 | (if (not (and coding-system (coding-system-p coding-system))) | |
223 | (error "Invalid coding system `%s'" coding-system)) | |
224 | (let ((coding-category (coding-system-category coding-system)) | |
8efc03e1 | 225 | (base (coding-system-base coding-system))) |
0c3154d2 KH |
226 | (if (not coding-category) |
227 | ;; CODING-SYSTEM is no-conversion or undecided. | |
228 | (error "Can't prefer the coding system `%s'" coding-system)) | |
8efc03e1 | 229 | (set coding-category (or base coding-system)) |
54b226f7 | 230 | (update-iso-coding-systems) |
0c3154d2 KH |
231 | (if (not (eq coding-category (car coding-category-list))) |
232 | ;; We must change the order. | |
233 | (setq coding-category-list | |
234 | (cons coding-category | |
235 | (delq coding-category coding-category-list)))) | |
8efc03e1 KH |
236 | (if (and base (interactive-p)) |
237 | (message "Highest priority is set to %s (base of %s)" | |
238 | base coding-system)) | |
239 | (set-default-coding-systems (or base coding-system)))) | |
0c3154d2 | 240 | |
3fc7dfe5 | 241 | (defun subset-p (list1 list2) |
54b226f7 KH |
242 | "Return non-nil if all elements in LIST1 are included in LIST2. |
243 | Comparison done with EQ." | |
244 | (catch 'tag | |
245 | (while list1 | |
246 | (or (memq (car list1) list2) | |
247 | (throw 'tag nil)) | |
248 | (setq list1 (cdr list1))) | |
249 | t)) | |
250 | ||
3fc7dfe5 | 251 | (defun find-coding-systems-region (from to) |
54b226f7 KH |
252 | "Return a list of proper coding systems to encode a text between FROM and TO. |
253 | All coding systems in the list can safely encode any multibyte characters | |
254 | in the text. | |
255 | ||
256 | If the text contains no multibyte charcters, return a list of a single | |
3fc7dfe5 KH |
257 | element `undecided'." |
258 | (find-coding-systems-for-charsets (find-charset-region from to))) | |
54b226f7 | 259 | |
3fc7dfe5 KH |
260 | (defun find-coding-systems-string (string) |
261 | "Return a list of proper coding systems to encode STRING. | |
262 | All coding systems in the list can safely encode any multibyte characters | |
263 | in STRING. | |
264 | ||
265 | If STRING contains no multibyte charcters, return a list of a single | |
266 | element `undecided'." | |
267 | (find-coding-systems-for-charsets (find-charset-string string))) | |
268 | ||
269 | (defun find-coding-systems-for-charsets (charsets) | |
270 | "Return a list of proper coding systems to encode characters of CHARSETS. | |
271 | CHARSETS is a list of character sets." | |
272 | (if (or (null charsets) | |
273 | (and (= (length charsets) 1) | |
274 | (eq 'ascii (car charsets)))) | |
275 | '(undecided) | |
276 | (let ((l coding-system-list) | |
34104362 | 277 | (charset-prefered-codings |
3fc7dfe5 KH |
278 | (mapcar (function |
279 | (lambda (x) | |
280 | (get-charset-property x 'prefered-coding-system))) | |
281 | charsets)) | |
34104362 KH |
282 | (priorities (mapcar (function (lambda (x) (symbol-value x))) |
283 | coding-category-list)) | |
3fc7dfe5 KH |
284 | codings coding safe) |
285 | (while l | |
286 | (setq coding (car l) l (cdr l)) | |
287 | (if (and (eq coding (coding-system-base coding)) | |
288 | (setq safe (coding-system-get coding 'safe-charsets)) | |
289 | (or (eq safe t) | |
290 | (subset-p charsets safe))) | |
291 | ;; We put the higher priority to coding systems included | |
34104362 KH |
292 | ;; in CHARSET-PREFERED-CODINGS, and within them, put the |
293 | ;; higher priority to coding systems which support smaller | |
3fc7dfe5 KH |
294 | ;; number of charsets. |
295 | (let ((priority | |
34104362 KH |
296 | (+ (if (coding-system-get coding 'mime-charset) 4096 0) |
297 | (lsh (length (memq coding priorities)) 7) | |
298 | (if (memq coding charset-prefered-codings) 64 0) | |
299 | (if (> (coding-system-type coding) 0) 32 0) | |
300 | (if (consp safe) (- 32 (length safe)) 0)))) | |
3fc7dfe5 KH |
301 | (setq codings (cons (cons priority coding) codings))))) |
302 | (mapcar 'cdr | |
303 | (sort codings (function (lambda (x y) (> (car x) (car y)))))) | |
304 | ))) | |
54b226f7 | 305 | |
c83c4f60 RS |
306 | (defvar last-coding-system-specified nil |
307 | "Most recent coding system explicitly specified by the user when asked. | |
308 | This variable is set whenever Emacs asks the user which coding system | |
309 | to use in order to write a file. If you set it to nil explicitly, | |
310 | then call `write-region', then afterward this variable will be non-nil | |
311 | only if the user was explicitly asked and specified a coding system.") | |
312 | ||
54b226f7 | 313 | (defun select-safe-coding-system (from to &optional default-coding-system) |
d5266ddf KH |
314 | "Ask a user to select a safe coding system from candidates. |
315 | The candidates of coding systems which can safely encode a text | |
316 | between FROM and TO are shown in a popup window. | |
54b226f7 KH |
317 | |
318 | Optional arg DEFAULT-CODING-SYSTEM specifies a coding system to be | |
319 | checked at first. If omitted, buffer-file-coding-system of the | |
320 | current buffer is used. | |
321 | ||
d5266ddf KH |
322 | If the text can be encoded safely by DEFAULT-CODING-SYSTEM, it is |
323 | returned without any user interaction. | |
54b226f7 KH |
324 | |
325 | Kludgy feature: if FROM is a string, the string is the target text, | |
326 | and TO is ignored." | |
327 | (or default-coding-system | |
328 | (setq default-coding-system buffer-file-coding-system)) | |
3fc7dfe5 KH |
329 | (let ((safe-coding-systems (if (stringp from) |
330 | (find-coding-systems-string from) | |
331 | (find-coding-systems-region from to)))) | |
54b226f7 KH |
332 | (if (or (eq (car safe-coding-systems) 'undecided) |
333 | (and default-coding-system | |
334 | (memq (coding-system-base default-coding-system) | |
335 | safe-coding-systems))) | |
336 | default-coding-system | |
337 | ||
34104362 KH |
338 | ;; At first, change each coding system to the corresponding |
339 | ;; mime-charset name if it is also a coding system. | |
340 | (let ((l safe-coding-systems) | |
341 | mime-charset) | |
342 | (while l | |
343 | (setq mime-charset (coding-system-get (car l) 'mime-charset)) | |
344 | (if (and mime-charset (coding-system-p mime-charset)) | |
345 | (setcar l mime-charset)) | |
346 | (setq l (cdr l)))) | |
347 | ||
348 | ;; Then, ask a user to select a proper coding system. | |
54b226f7 KH |
349 | (save-window-excursion |
350 | ;; At first, show a helpful message. | |
351 | (with-output-to-temp-buffer "*Warning*" | |
352 | (save-excursion | |
353 | (set-buffer standard-output) | |
354 | (insert (format "\ | |
355 | The target text contains a multibyte character which can't be | |
356 | encoded safely by the coding system %s. | |
357 | ||
358 | Please select one from the following safe coding systems:\n" | |
359 | default-coding-system)) | |
360 | (let ((pos (point)) | |
361 | (fill-prefix " ")) | |
362 | (mapcar (function (lambda (x) (princ " ") (princ x))) | |
363 | safe-coding-systems) | |
364 | (fill-region-as-paragraph pos (point))))) | |
365 | ||
366 | ;; Read a coding system. | |
34104362 KH |
367 | (unwind-protect |
368 | (let* ((safe-names (mapcar (lambda (x) (list (symbol-name x))) | |
369 | safe-coding-systems)) | |
370 | (name (completing-read | |
371 | (format "Select coding system (default %s): " | |
372 | (car safe-coding-systems)) | |
373 | safe-names nil t nil nil (car (car safe-names))))) | |
c83c4f60 | 374 | (setq last-coding-system-specified (intern name))) |
34104362 | 375 | (kill-buffer "*Warning*")))))) |
54b226f7 KH |
376 | |
377 | (setq select-safe-coding-system-function 'select-safe-coding-system) | |
378 | ||
4ed46869 KH |
379 | \f |
380 | ;;; Language support staffs. | |
381 | ||
4ed46869 KH |
382 | (defvar language-info-alist nil |
383 | "Alist of language names vs the corresponding information of various kind. | |
384 | Each element looks like: | |
385 | (LANGUAGE-NAME . ((KEY . INFO) ...)) | |
386 | where LANGUAGE-NAME is a string, | |
387 | KEY is a symbol denoting the kind of information, | |
388 | INFO is any Lisp object which contains the actual information related | |
389 | to KEY.") | |
390 | ||
391 | (defun get-language-info (language-name key) | |
392 | "Return the information for LANGUAGE-NAME of the kind KEY. | |
4ed46869 | 393 | KEY is a symbol denoting the kind of required information." |
4ef06f75 KH |
394 | (if (symbolp language-name) |
395 | (setq language-name (symbol-name language-name))) | |
15b3e511 | 396 | (let ((lang-slot (assoc-ignore-case language-name language-info-alist))) |
4ed46869 KH |
397 | (if lang-slot |
398 | (cdr (assq key (cdr lang-slot)))))) | |
399 | ||
54b226f7 KH |
400 | (defun set-language-info (language-name key info |
401 | &optional describe-map setup-map) | |
4ed46869 | 402 | "Set for LANGUAGE-NAME the information INFO under KEY. |
4ed46869 | 403 | KEY is a symbol denoting the kind of information. |
54b226f7 KH |
404 | INFO is any Lisp object which contains the actual information specific |
405 | to LANGUAGE-NAME. | |
4ed46869 KH |
406 | |
407 | Currently, the following KEYs are used by Emacs: | |
281d03ec | 408 | |
54b226f7 KH |
409 | charset: list of charsets. |
410 | ||
411 | coding-system: list of coding systems. | |
281d03ec | 412 | |
54b226f7 | 413 | coding-priority: list of coding systems ordered by priority. |
281d03ec | 414 | |
4ed46869 | 415 | tutorial: a tutorial file name written in the language. |
281d03ec | 416 | |
4ed46869 | 417 | sample-text: one line short text containing characters of the language. |
281d03ec | 418 | |
15b3e511 | 419 | documentation: t or a string describing how Emacs supports the language. |
54b226f7 KH |
420 | If a string is specified, it is shown before any other information |
421 | of the language by the command `describe-language-environment'. | |
281d03ec | 422 | |
13e82c04 | 423 | setup-function: a function to call for setting up environment |
54b226f7 | 424 | convenient for a user of the language. |
13e82c04 | 425 | |
281d03ec | 426 | We will define more KEYs in the future. To avoid conflict, |
54b226f7 KH |
427 | if you want to use your own KEY values, make them start with `user-'. |
428 | ||
429 | Optional 4th and 5th args DESCRIBE-MAP and SETUP-MAP are keymaps to | |
430 | register LANGUAGE-NAME in the menu of `Mule'->`Describe Language | |
431 | Environment' and `Mule'->`Setup Language Environment' respectively." | |
4ef06f75 KH |
432 | (if (symbolp language-name) |
433 | (setq language-name (symbol-name language-name))) | |
4ed46869 KH |
434 | (let (lang-slot key-slot) |
435 | (setq lang-slot (assoc language-name language-info-alist)) | |
436 | (if (null lang-slot) ; If no slot for the language, add it. | |
437 | (setq lang-slot (list language-name) | |
438 | language-info-alist (cons lang-slot language-info-alist))) | |
439 | (setq key-slot (assq key lang-slot)) | |
440 | (if (null key-slot) ; If no slot for the key, add it. | |
441 | (progn | |
442 | (setq key-slot (list key)) | |
443 | (setcdr lang-slot (cons key-slot (cdr lang-slot))))) | |
4ed46869 | 444 | ;; Setup menu. |
48082651 | 445 | (cond ((eq key 'documentation) |
54b226f7 KH |
446 | (define-key-after describe-map (vector (intern language-name)) |
447 | (cons language-name 'describe-specified-language-support) t)) | |
ef8a8c8c | 448 | ((eq key 'setup-function) |
54b226f7 KH |
449 | (define-key-after setup-map (vector (intern language-name)) |
450 | (cons language-name 'setup-specified-language-environment) t))) | |
15b3e511 KH |
451 | |
452 | (setcdr key-slot info) | |
4ed46869 KH |
453 | )) |
454 | ||
54b226f7 | 455 | (defun set-language-info-alist (language-name alist &optional parents) |
4ed46869 KH |
456 | "Set for LANGUAGE-NAME the information in ALIST. |
457 | ALIST is an alist of KEY and INFO. See the documentation of | |
54b226f7 KH |
458 | `set-langauge-info' for the meanings of KEY and INFO. |
459 | ||
460 | Optional arg PARENTS is a list of parent language environments ordered | |
461 | from the highest to the lower. If it is nil, we make LANGUAGE-NAME | |
462 | the top level language environment." | |
4ef06f75 KH |
463 | (if (symbolp language-name) |
464 | (setq language-name (symbol-name language-name))) | |
54b226f7 KH |
465 | (let ((describe-map describe-language-environment-map) |
466 | (setup-map setup-language-environment-map)) | |
467 | (if parents | |
468 | (let ((l parents) | |
469 | map parent-symbol parent) | |
470 | (while l | |
471 | (if (symbolp (setq parent-symbol (car l))) | |
472 | (setq parent (symbol-name parent)) | |
473 | (setq parent parent-symbol parent-symbol (intern parent))) | |
474 | (setq map (lookup-key describe-map (vector parent-symbol))) | |
475 | (if (not map) | |
476 | (progn | |
477 | (setq map (intern (format "describe-%s-environment-map" | |
478 | (downcase parent)))) | |
479 | (define-prefix-command map) | |
480 | (define-key-after describe-map (vector parent-symbol) | |
481 | (cons parent map) t))) | |
482 | (setq describe-map (symbol-value map)) | |
483 | (setq map (lookup-key setup-map (vector parent-symbol))) | |
484 | (if (not map) | |
485 | (progn | |
486 | (setq map (intern (format "setup-%s-environment-map" | |
487 | (downcase parent)))) | |
488 | (define-prefix-command map) | |
489 | (define-key-after setup-map (vector parent-symbol) | |
490 | (cons parent map) t))) | |
491 | (setq setup-map (symbol-value map)) | |
492 | (setq l (cdr l))))) | |
493 | (while alist | |
494 | (set-language-info language-name (car (car alist)) (cdr (car alist)) | |
495 | describe-map setup-map) | |
496 | (setq alist (cdr alist))))) | |
4ed46869 | 497 | |
ae302641 | 498 | (defun read-language-name (key prompt &optional default) |
4ef06f75 | 499 | "Read language name which has information for KEY, prompting with PROMPT. |
ae302641 | 500 | DEFAULT is the default choice of language. |
fc0678af | 501 | This returns a language name as a string." |
4ed46869 KH |
502 | (let* ((completion-ignore-case t) |
503 | (name (completing-read prompt | |
504 | language-info-alist | |
505 | (function (lambda (elm) (assq key elm))) | |
ae302641 | 506 | t nil nil default))) |
13e82c04 KH |
507 | (if (and (> (length name) 0) |
508 | (get-language-info name key)) | |
509 | name))) | |
4ed46869 KH |
510 | \f |
511 | ;;; Multilingual input methods. | |
512 | ||
d0b9c3ab KH |
513 | (defconst leim-list-file-name "leim-list.el" |
514 | "Name of LEIM list file. | |
515 | This file contains a list of libraries of Emacs input methods (LEIM) | |
516 | in the format of Lisp expression for registering each input method. | |
517 | Emacs loads this file at startup time.") | |
518 | ||
519 | (defvar leim-list-header (format "\ | |
520 | ;;; %s -- list of LEIM (Library of Emacs Input Method) | |
521 | ;; | |
522 | ;; This file contains a list of LEIM (Library of Emacs Input Method) | |
523 | ;; in the same directory as this file. Loading this file registeres | |
524 | ;; the whole input methods in Emacs. | |
525 | ;; | |
d33d5fbe | 526 | ;; Each entry has the form: |
d0b9c3ab KH |
527 | ;; (register-input-method |
528 | ;; INPUT-METHOD LANGUAGE-NAME ACTIVATE-FUNC | |
529 | ;; TITLE DESCRIPTION | |
530 | ;; ARG ...) | |
531 | ;; See the function `register-input-method' for the meanings of arguments. | |
532 | ;; | |
533 | ;; If this directory is included in load-path, Emacs automatically | |
534 | ;; loads this file at startup time. | |
535 | ||
536 | " | |
537 | leim-list-file-name) | |
538 | "Header to be inserted in LEIM list file.") | |
539 | ||
e55e92ee | 540 | (defvar leim-list-entry-regexp "^(register-input-method" |
d0b9c3ab KH |
541 | "Regexp matching head of each entry in LEIM list file. |
542 | See also the variable `leim-list-header'") | |
543 | ||
544 | (defvar update-leim-list-functions | |
545 | '(quail-update-leim-list-file) | |
546 | "List of functions to call to update LEIM list file. | |
547 | Each function is called with one arg, LEIM directory name.") | |
548 | ||
a337fe7f RS |
549 | (defun update-leim-list-file (&rest dirs) |
550 | "Update LEIM list file in directories DIRS." | |
d0b9c3ab KH |
551 | (let ((functions update-leim-list-functions)) |
552 | (while functions | |
a337fe7f | 553 | (apply (car functions) dirs) |
d0b9c3ab KH |
554 | (setq functions (cdr functions))))) |
555 | ||
4ed46869 KH |
556 | (defvar current-input-method nil |
557 | "The current input method for multilingual text. | |
96db204a | 558 | If nil, that means no input method is activated now.") |
4ed46869 KH |
559 | (make-variable-buffer-local 'current-input-method) |
560 | (put 'current-input-method 'permanent-local t) | |
561 | ||
562 | (defvar current-input-method-title nil | |
d0b9c3ab | 563 | "Title string of the current input method shown in mode line.") |
4ed46869 KH |
564 | (make-variable-buffer-local 'current-input-method-title) |
565 | (put 'current-input-method-title 'permanent-local t) | |
566 | ||
b4fba33f | 567 | (defcustom default-input-method nil |
8861c593 | 568 | "*Default input method for multilingual text (a string). |
b4fba33f | 569 | This is the input method activated automatically by the command |
9b10b5a3 | 570 | `toggle-input-method' (\\[toggle-input-method])." |
8861c593 RS |
571 | :group 'mule |
572 | :type 'string) | |
b4fba33f | 573 | |
723a427a KH |
574 | (defvar input-method-history nil |
575 | "History list for some commands that read input methods.") | |
576 | (make-variable-buffer-local 'input-method-history) | |
577 | (put 'input-method-history 'permanent-local t) | |
4ed46869 KH |
578 | |
579 | (defvar inactivate-current-input-method-function nil | |
580 | "Function to call for inactivating the current input method. | |
581 | Every input method should set this to an appropriate value when activated. | |
f17ccaee KH |
582 | This function is called with no argument. |
583 | ||
584 | This function should never change the value of `current-input-method'. | |
585 | It is set to nil by the function `inactivate-input-method'.") | |
4ed46869 KH |
586 | (make-variable-buffer-local 'inactivate-current-input-method-function) |
587 | (put 'inactivate-current-input-method-function 'permanent-local t) | |
588 | ||
589 | (defvar describe-current-input-method-function nil | |
590 | "Function to call for describing the current input method. | |
591 | This function is called with no argument.") | |
592 | (make-variable-buffer-local 'describe-current-input-method-function) | |
593 | (put 'describe-current-input-method-function 'permanent-local t) | |
594 | ||
d0b9c3ab KH |
595 | (defvar input-method-alist nil |
596 | "Alist of input method names vs the corresponding information to use it. | |
597 | Each element has the form: | |
598 | (INPUT-METHOD LANGUAGE-NAME ACTIVATE-FUNC TITLE DESCRIPTION ...) | |
599 | See the function `register-input-method' for the meanings of each elements.") | |
600 | ||
601 | (defun register-input-method (input-method language-name &rest args) | |
602 | "Register INPUT-METHOD as an input method for LANGUAGE-NAME. | |
4ef06f75 | 603 | INPUT-METHOD and LANGUAGE-NAME are symbols or strings. |
d0b9c3ab KH |
604 | The remaining arguments are: |
605 | ACTIVATE-FUNC, TITLE, DESCRIPTION, and ARG ... | |
606 | where, | |
607 | ACTIVATE-FUNC is a function to call for activating this method. | |
608 | TITLE is a string shown in mode-line while this method is active, | |
609 | DESCRIPTION is a string describing about this method, | |
610 | Arguments to ACTIVATE-FUNC are INPUT-METHOD and ARGs." | |
4ef06f75 KH |
611 | (if (symbolp language-name) |
612 | (setq language-name (symbol-name language-name))) | |
613 | (if (symbolp input-method) | |
614 | (setq input-method (symbol-name input-method))) | |
d0b9c3ab KH |
615 | (let ((info (cons language-name args)) |
616 | (slot (assoc input-method input-method-alist))) | |
617 | (if slot | |
618 | (setcdr slot info) | |
619 | (setq slot (cons input-method info)) | |
620 | (setq input-method-alist (cons slot input-method-alist))))) | |
621 | ||
4d5ac029 | 622 | (defun read-input-method-name (prompt &optional default inhibit-null) |
d0b9c3ab | 623 | "Read a name of input method from a minibuffer prompting with PROMPT. |
4d5ac029 RS |
624 | If DEFAULT is non-nil, use that as the default, |
625 | and substitute it into PROMPT at the first `%s'. | |
4ef06f75 KH |
626 | If INHIBIT-NULL is non-nil, null input signals an error. |
627 | ||
628 | The return value is a string." | |
4d5ac029 RS |
629 | (if default |
630 | (setq prompt (format prompt default))) | |
d0b9c3ab | 631 | (let* ((completion-ignore-case t) |
723a427a KH |
632 | ;; This binding is necessary because input-method-history is |
633 | ;; buffer local. | |
d0b9c3ab | 634 | (input-method (completing-read prompt input-method-alist |
87505a98 RS |
635 | nil t nil 'input-method-history |
636 | default))) | |
d0b9c3ab KH |
637 | (if (> (length input-method) 0) |
638 | input-method | |
639 | (if inhibit-null | |
43807b77 | 640 | (error "No valid input method is specified"))))) |
d0b9c3ab | 641 | |
d0b9c3ab | 642 | (defun activate-input-method (input-method) |
f17ccaee KH |
643 | "Turn INPUT-METHOD on. |
644 | If some input method is already on, turn it off at first." | |
4ef06f75 KH |
645 | (if (symbolp input-method) |
646 | (setq input-method (symbol-name input-method))) | |
723a427a KH |
647 | (if (and current-input-method |
648 | (not (string= current-input-method input-method))) | |
42395763 RS |
649 | (inactivate-input-method)) |
650 | (unless current-input-method | |
d0b9c3ab KH |
651 | (let ((slot (assoc input-method input-method-alist))) |
652 | (if (null slot) | |
723a427a | 653 | (error "Can't activate input method `%s'" input-method)) |
8efc03e1 KH |
654 | (let ((func (nth 2 slot))) |
655 | (if (functionp func) | |
656 | (apply (nth 2 slot) input-method (nthcdr 5 slot)) | |
657 | (if (and (consp func) (symbolp (car func)) (symbolp (cdr func))) | |
658 | (progn | |
659 | (require (cdr func)) | |
660 | (apply (car func) input-method (nthcdr 5 slot))) | |
661 | (error "Can't activate input method `%s'" input-method)))) | |
d0b9c3ab | 662 | (setq current-input-method input-method) |
723a427a KH |
663 | (setq current-input-method-title (nth 3 slot)) |
664 | (run-hooks 'input-method-activate-hook)))) | |
15b3e511 | 665 | |
15b3e511 | 666 | (defun inactivate-input-method () |
f17ccaee | 667 | "Turn off the current input method." |
723a427a KH |
668 | (when current-input-method |
669 | (if input-method-history | |
670 | (unless (string= current-input-method (car input-method-history)) | |
671 | (setq input-method-history | |
672 | (cons current-input-method | |
673 | (delete current-input-method input-method-history)))) | |
674 | (setq input-method-history (list current-input-method))) | |
675 | (unwind-protect | |
676 | (funcall inactivate-current-input-method-function) | |
15b3e511 | 677 | (unwind-protect |
723a427a KH |
678 | (run-hooks 'input-method-inactivate-hook) |
679 | (setq current-input-method nil | |
680 | current-input-method-title nil))))) | |
4ed46869 | 681 | |
8b784951 | 682 | (defun set-input-method (input-method) |
723a427a KH |
683 | "Select and turn on INPUT-METHOD. |
684 | This sets the default input method to what you specify, | |
685 | and turn it on for the current buffer." | |
d0b9c3ab | 686 | (interactive |
723a427a | 687 | (let* ((default (or (car input-method-history) default-input-method))) |
42395763 | 688 | (list (read-input-method-name |
87505a98 | 689 | (if default "Select input method (default %s): " "Select input method: ") |
42395763 | 690 | default t)))) |
d0b9c3ab | 691 | (activate-input-method input-method) |
42395763 | 692 | (setq default-input-method input-method)) |
4ed46869 KH |
693 | |
694 | (defun toggle-input-method (&optional arg) | |
15b3e511 | 695 | "Turn on or off a multilingual text input method for the current buffer. |
723a427a | 696 | |
7ddbb5bc RS |
697 | With no prefix argument, if some input method is currently activated, |
698 | turn it off. Otherwise, activate an input method--the one most recently used, | |
699 | or the one specified in `default-input-method', or one read from the | |
700 | minibuffer. | |
723a427a | 701 | |
7ddbb5bc RS |
702 | With a prefix arg, read an input method from minibuffer and turn it on. |
703 | The default is the most recent input method specified | |
704 | \(not including the currently active input method, if any). | |
723a427a KH |
705 | |
706 | When there's no input method to turn on, turn on what read from minibuffer." | |
4ed46869 | 707 | (interactive "P") |
7ddbb5bc RS |
708 | (if (and current-input-method (not arg)) |
709 | (inactivate-input-method) | |
710 | (let ((default (or (car input-method-history) default-input-method))) | |
711 | (if (and arg default (equal current-input-method default) | |
712 | (> (length input-method-history) 1)) | |
713 | (setq default (nth 1 input-method-history))) | |
723a427a KH |
714 | (activate-input-method |
715 | (if (or arg (not default)) | |
7ddbb5bc RS |
716 | (progn |
717 | (read-input-method-name | |
718 | (if default "Input method (default %s): " "Input method: " ) | |
719 | default t)) | |
723a427a KH |
720 | default)) |
721 | (or default-input-method | |
722 | (setq default-input-method current-input-method))))) | |
d0b9c3ab KH |
723 | |
724 | (defun describe-input-method (input-method) | |
4ef06f75 | 725 | "Describe input method INPUT-METHOD." |
d0b9c3ab KH |
726 | (interactive |
727 | (list (read-input-method-name | |
728 | "Describe input method (default, current choice): "))) | |
78754934 | 729 | (if (and input-method (symbolp input-method)) |
4ef06f75 | 730 | (setq input-method (symbol-name input-method))) |
d0b9c3ab KH |
731 | (if (null input-method) |
732 | (describe-current-input-method) | |
733 | (with-output-to-temp-buffer "*Help*" | |
734 | (let ((elt (assoc input-method input-method-alist))) | |
735 | (princ (format "Input method: %s (`%s' in mode line) for %s\n %s\n" | |
736 | input-method (nth 3 elt) (nth 1 elt) (nth 4 elt))))))) | |
737 | ||
738 | (defun describe-current-input-method () | |
96db204a | 739 | "Describe the input method currently in use." |
4ed46869 KH |
740 | (if current-input-method |
741 | (if (and (symbolp describe-current-input-method-function) | |
742 | (fboundp describe-current-input-method-function)) | |
743 | (funcall describe-current-input-method-function) | |
744 | (message "No way to describe the current input method `%s'" | |
745 | (cdr current-input-method)) | |
746 | (ding)) | |
d0b9c3ab | 747 | (error "No input method is activated now"))) |
4ed46869 | 748 | |
d3459641 | 749 | (defun read-multilingual-string (prompt &optional initial-input input-method) |
4ed46869 KH |
750 | "Read a multilingual string from minibuffer, prompting with string PROMPT. |
751 | The input method selected last time is activated in minibuffer. | |
15b3e511 | 752 | If optional second arg INITIAL-INPUT is non-nil, insert it in the minibuffer |
d0b9c3ab KH |
753 | initially. |
754 | Optional 3rd argument INPUT-METHOD specifies the input method | |
4ef06f75 KH |
755 | to be activated instead of the one selected last time. It is a symbol |
756 | or a string." | |
88d559ec KH |
757 | (setq input-method |
758 | (or input-method | |
d3459641 | 759 | current-input-method |
88d559ec KH |
760 | default-input-method |
761 | (read-input-method-name "Input method: " nil t))) | |
3df60841 | 762 | (if (and input-method (symbolp input-method)) |
4ef06f75 | 763 | (setq input-method (symbol-name input-method))) |
d3459641 KH |
764 | (let ((previous-input-method current-input-method)) |
765 | (unwind-protect | |
766 | (progn | |
767 | (activate-input-method input-method) | |
768 | (read-string prompt initial-input nil nil t)) | |
769 | (if previous-input-method | |
770 | (activate-input-method previous-input-method) | |
771 | (inactivate-input-method))))) | |
4ed46869 KH |
772 | |
773 | ;; Variables to control behavior of input methods. All input methods | |
774 | ;; should react to these variables. | |
775 | ||
8efc03e1 KH |
776 | (defcustom input-method-verbose-flag 'default |
777 | "*A flag to control extra guidance given by input methods. | |
778 | The value should be nil, t, `complex-only', or `default'. | |
4ed46869 | 779 | |
cb29dfb6 | 780 | The extra guidance is done by showing list of available keys in echo |
8efc03e1 KH |
781 | area. When you use the input method in the minibuffer, the guidance |
782 | is shown at the bottom short window (split from the existing window). | |
c27c4ed8 | 783 | |
8efc03e1 KH |
784 | If the value is t, extra guidance is always given, if the value is |
785 | nil, extra guidance is always suppressed. | |
786 | ||
787 | If the value is `complex-only', only complex input methods such as | |
788 | `chinese-py' and `japanese' give extra guidance. | |
789 | ||
790 | If the value is `default', complex input methods always give extra | |
791 | guidance, but simple input methods give it only when you are not in | |
792 | the minibuffer. | |
793 | ||
794 | See also the variable `input-method-highlight-flag'." | |
795 | :type '(choice (const t) (const nil) (const complex-only) (const default)) | |
42395763 RS |
796 | :group 'mule) |
797 | ||
798 | (defcustom input-method-highlight-flag t | |
799 | "*If this flag is non-nil, input methods highlight partially-entered text. | |
800 | For instance, while you are in the middle of a Quail input method sequence, | |
801 | the text inserted so far is temporarily underlined. | |
8efc03e1 KH |
802 | The underlining goes away when you finish or abort the input method sequence. |
803 | See also the variable `input-method-verbose-flag'." | |
42395763 RS |
804 | :type 'boolean |
805 | :group 'mule) | |
4ed46869 KH |
806 | |
807 | (defvar input-method-activate-hook nil | |
f17ccaee KH |
808 | "Normal hook run just after an input method is activated. |
809 | ||
810 | The variable `current-input-method' keeps the input method name | |
811 | just activated.") | |
4ed46869 KH |
812 | |
813 | (defvar input-method-inactivate-hook nil | |
f17ccaee KH |
814 | "Normal hook run just after an input method is inactivated. |
815 | ||
816 | The variable `current-input-method' still keeps the input method name | |
4d0e6a11 | 817 | just inactivated.") |
4ed46869 KH |
818 | |
819 | (defvar input-method-after-insert-chunk-hook nil | |
820 | "Normal hook run just after an input method insert some chunk of text.") | |
821 | ||
723a427a KH |
822 | (defvar input-method-exit-on-invalid-key nil |
823 | "This flag controls the behaviour of an input method on invalid key input. | |
824 | Usually, when a user types a key which doesn't start any character | |
825 | handled by the input method, the key is handled by turning off the | |
826 | input method temporalily. After the key is handled, the input method is | |
827 | back on. | |
828 | But, if this flag is non-nil, the input method is never back on.") | |
829 | ||
4ed46869 | 830 | \f |
8efc03e1 KH |
831 | (defvar set-language-environment-hook nil |
832 | "Normal hook run after some language environment is set. | |
833 | ||
834 | When you set some hook function here, that effect usually should not | |
835 | be inherited to another language environment. So, you had better set | |
836 | another function in `exit-language-environment-hook' (which see) to | |
837 | cancel the effect.") | |
838 | ||
839 | (defvar exit-language-environment-hook nil | |
840 | "Normal hook run after exiting from some language environment. | |
841 | When this hook is run, the variable `current-language-environment' | |
842 | is still bound to the language environment being exited. | |
843 | ||
844 | This hook is mainly used for cancelling the effect of | |
845 | `set-language-environment-hook' (which-see).") | |
846 | ||
15b3e511 | 847 | (defun setup-specified-language-environment () |
f850d782 | 848 | "Set up multi-lingual environment convenient for the specified language." |
15b3e511 | 849 | (interactive) |
f850d782 | 850 | (let (language-name) |
15b3e511 KH |
851 | (if (and (symbolp last-command-event) |
852 | (or (not (eq last-command-event 'Default)) | |
853 | (setq last-command-event 'English)) | |
f850d782 RS |
854 | (setq language-name (symbol-name last-command-event))) |
855 | (set-language-environment language-name) | |
15b3e511 | 856 | (error "Bogus calling sequence")))) |
4ed46869 | 857 | |
8861c593 RS |
858 | (defcustom current-language-environment "English" |
859 | "The last language environment specified with `set-language-environment'." | |
860 | :set 'set-language-environment | |
861 | :initialize 'custom-initialize-default | |
862 | :group 'mule | |
863 | :type 'string) | |
f850d782 | 864 | |
166246f7 | 865 | (defun set-language-environment (language-name) |
6c05d680 RS |
866 | "Set up multi-lingual environment for using LANGUAGE-NAME. |
867 | This sets the coding system priority and the default input method | |
8861c593 RS |
868 | and sometimes other things. LANGUAGE-NAME should be a string |
869 | which is the name of a language environment. For example, \"Latin-1\" | |
870 | specifies the character set for the major languages of Western Europe." | |
8efc03e1 KH |
871 | (interactive (list (read-language-name |
872 | 'setup-function | |
873 | "Set language environment (default, English): "))) | |
4ef06f75 KH |
874 | (if language-name |
875 | (if (symbolp language-name) | |
876 | (setq language-name (symbol-name language-name))) | |
877 | (setq language-name "English")) | |
b4fba33f | 878 | (if (null (get-language-info language-name 'setup-function)) |
f850d782 | 879 | (error "Language environment not defined: %S" language-name)) |
e728468b | 880 | (unless default-enable-multibyte-characters |
51a8fc1d | 881 | (or (member (downcase language-name) |
e728468b | 882 | '("latin-1" "latin-2" "latin-3" "latin-4" "latin-5")) |
51a8fc1d RS |
883 | (error "Language environment `%s' not supported in unibyte mode" |
884 | language-name)) | |
885 | (set-terminal-coding-system (intern (downcase language-name))) | |
886 | (standard-display-european-internal)) | |
e728468b | 887 | |
8efc03e1 KH |
888 | (if current-language-environment |
889 | (let ((func (get-language-info current-language-environment | |
890 | 'exit-function))) | |
e63645c2 KH |
891 | (run-hooks 'exit-language-environment-hook) |
892 | (if (fboundp func) (funcall func)))) | |
f850d782 | 893 | (setq current-language-environment language-name) |
8efc03e1 KH |
894 | (funcall (get-language-info language-name 'setup-function)) |
895 | (run-hooks 'set-language-environment-hook) | |
f850d782 | 896 | (force-mode-line-update t)) |
4ed46869 | 897 | |
51a8fc1d RS |
898 | (defun standard-display-european-internal () |
899 | ;; Actually set up direct output of non-ASCII characters. | |
900 | (standard-display-8bit 160 255) | |
901 | ;; Make non-line-break space display as a plain space. | |
902 | ;; Most X fonts do the wrong thing for code 160. | |
903 | (aset standard-display-table 160 [32]) | |
904 | ;; Most Windows programs send out apostrophe's as \222. Most X fonts | |
905 | ;; don't contain a character at that position. Map it to the ASCII | |
906 | ;; apostrophe. | |
907 | (aset standard-display-table 146 [39])) | |
908 | ||
54b226f7 KH |
909 | (defun set-language-environment-coding-systems (language-name) |
910 | "Do various coding system setups for language environment LANGUAGE-NAME." | |
911 | (let* ((priority (get-language-info language-name 'coding-priority)) | |
912 | (default-coding (car priority))) | |
913 | (if priority | |
914 | (let ((categories (mapcar 'coding-system-category priority))) | |
915 | (set-default-coding-systems default-coding) | |
916 | (set-coding-priority categories) | |
917 | (while priority | |
918 | (set (car categories) (car priority)) | |
919 | (setq priority (cdr priority) categories (cdr categories))) | |
920 | (update-iso-coding-systems))))) | |
921 | ||
4ed46869 KH |
922 | ;; Print all arguments with `princ', then print "\n". |
923 | (defsubst princ-list (&rest args) | |
924 | (while args (princ (car args)) (setq args (cdr args))) | |
925 | (princ "\n")) | |
926 | ||
48082651 | 927 | ;; Print a language specific information such as input methods, |
13e82c04 | 928 | ;; charsets, and coding systems. This function is intended to be |
48082651 | 929 | ;; called from the menu: |
281d03ec | 930 | ;; [menu-bar mule describe-language-environment LANGUAGE] |
48082651 KH |
931 | ;; and should not run it by `M-x describe-current-input-method-function'. |
932 | (defun describe-specified-language-support () | |
96db204a | 933 | "Describe how Emacs supports the specified language environment." |
48082651 | 934 | (interactive) |
281d03ec | 935 | (let (language-name) |
48082651 | 936 | (if (not (and (symbolp last-command-event) |
281d03ec | 937 | (setq language-name (symbol-name last-command-event)))) |
48082651 | 938 | (error "Bogus calling sequence")) |
281d03ec RS |
939 | (describe-language-environment language-name))) |
940 | ||
941 | (defun describe-language-environment (language-name) | |
942 | "Describe how Emacs supports language environment LANGUAGE-NAME." | |
78754934 KH |
943 | (interactive |
944 | (list (read-language-name | |
945 | 'documentation | |
8adfa8be | 946 | "Describe language environment (default, current choice): "))) |
f850d782 RS |
947 | (if (null language-name) |
948 | (setq language-name current-language-environment)) | |
281d03ec RS |
949 | (if (or (null language-name) |
950 | (null (get-language-info language-name 'documentation))) | |
951 | (error "No documentation for the specified language")) | |
4ef06f75 KH |
952 | (if (symbolp language-name) |
953 | (setq language-name (symbol-name language-name))) | |
281d03ec | 954 | (let ((doc (get-language-info language-name 'documentation))) |
48082651 | 955 | (with-output-to-temp-buffer "*Help*" |
a33c9d6f | 956 | (princ-list language-name " language environment" "\n") |
13e82c04 | 957 | (if (stringp doc) |
d0b9c3ab KH |
958 | (progn |
959 | (princ-list doc) | |
960 | (terpri))) | |
15b3e511 KH |
961 | (let ((str (get-language-info language-name 'sample-text))) |
962 | (if (stringp str) | |
963 | (progn | |
281d03ec | 964 | (princ "Sample text:\n") |
d0b9c3ab KH |
965 | (princ-list " " str) |
966 | (terpri)))) | |
281d03ec | 967 | (princ "Input methods:\n") |
d0b9c3ab | 968 | (let ((l input-method-alist)) |
15b3e511 | 969 | (while l |
d0b9c3ab KH |
970 | (if (string= language-name (nth 1 (car l))) |
971 | (princ-list " " (car (car l)) | |
972 | (format " (`%s' in mode line)" (nth 3 (car l))))) | |
15b3e511 | 973 | (setq l (cdr l)))) |
281d03ec RS |
974 | (terpri) |
975 | (princ "Character sets:\n") | |
15b3e511 KH |
976 | (let ((l (get-language-info language-name 'charset))) |
977 | (if (null l) | |
978 | (princ-list " nothing specific to " language-name) | |
979 | (while l | |
980 | (princ-list " " (car l) ": " | |
981 | (charset-description (car l))) | |
982 | (setq l (cdr l))))) | |
281d03ec RS |
983 | (terpri) |
984 | (princ "Coding systems:\n") | |
15b3e511 KH |
985 | (let ((l (get-language-info language-name 'coding-system))) |
986 | (if (null l) | |
987 | (princ-list " nothing specific to " language-name) | |
48082651 | 988 | (while l |
281d03ec RS |
989 | (princ (format " %s (`%c' in mode line):\n\t%s\n" |
990 | (car l) | |
991 | (coding-system-mnemonic (car l)) | |
a904b20b | 992 | (coding-system-doc-string (car l)))) |
8efc03e1 KH |
993 | (let ((aliases (coding-system-get (car l) 'alias-coding-systems))) |
994 | (when aliases | |
995 | (princ "\t") | |
996 | (princ (cons 'alias: (cdr aliases))) | |
997 | (terpri))) | |
15b3e511 | 998 | (setq l (cdr l)))))))) |
4ed46869 KH |
999 | \f |
1000 | ;;; Charset property | |
1001 | ||
1002 | (defsubst get-charset-property (charset propname) | |
1003 | "Return the value of CHARSET's PROPNAME property. | |
1004 | This is the last value stored with | |
96db204a | 1005 | (put-charset-property CHARSET PROPNAME VALUE)." |
4ed46869 KH |
1006 | (plist-get (charset-plist charset) propname)) |
1007 | ||
1008 | (defsubst put-charset-property (charset propname value) | |
1009 | "Store CHARSETS's PROPNAME property with value VALUE. | |
1010 | It can be retrieved with `(get-charset-property CHARSET PROPNAME)'." | |
1011 | (set-charset-plist charset | |
1012 | (plist-put (charset-plist charset) propname value))) | |
1013 | ||
1014 | ;;; Character code property | |
1015 | (put 'char-code-property-table 'char-table-extra-slots 0) | |
1016 | ||
1017 | (defvar char-code-property-table | |
1018 | (make-char-table 'char-code-property-table) | |
1019 | "Char-table containing a property list of each character code. | |
1020 | ||
1021 | See also the documentation of `get-char-code-property' and | |
96db204a | 1022 | `put-char-code-property'.") |
4ed46869 KH |
1023 | |
1024 | (defun get-char-code-property (char propname) | |
1025 | "Return the value of CHAR's PROPNAME property in `char-code-property-table'." | |
1026 | (let ((plist (aref char-code-property-table char))) | |
1027 | (if (listp plist) | |
1028 | (car (cdr (memq propname plist)))))) | |
1029 | ||
1030 | (defun put-char-code-property (char propname value) | |
1031 | "Store CHAR's PROPNAME property with VALUE in `char-code-property-table'. | |
1032 | It can be retrieved with `(get-char-code-property CHAR PROPNAME)'." | |
1033 | (let ((plist (aref char-code-property-table char))) | |
1034 | (if plist | |
1035 | (let ((slot (memq propname plist))) | |
1036 | (if slot | |
1037 | (setcar (cdr slot) value) | |
1038 | (nconc plist (list propname value)))) | |
1039 | (aset char-code-property-table char (list propname value))))) | |
1040 | ||
1041 | ;;; mule-cmds.el ends here |