Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-keyboard.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents
children 6608ceec7cf8
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; mule-keyboard.el --- Direct input of multilingual chars from keyboard.
2
3 ;; Copyright (C) 1992 Free Software Foundation, Inc.
4
5 ;; This file is part of XEmacs.
6
7 ;; XEmacs is free software; you can redistribute it and/or modify it
8 ;; under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation; either version 2, or (at your option)
10 ;; any later version.
11
12 ;; XEmacs is distributed in the hope that it will be useful, but
13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 ;; General Public License for more details.
16
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with XEmacs; see the file COPYING. If not, write to the
19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 ;; Boston, MA 02111-1307, USA.
21
22 ;;; 92.3.5 created for Mule Ver.0.9.0 by K.Handa <handa@etl.go.jp>
23
24 ;;;###autoload
25 (defvar keyboard-allow-latin-input nil
26 "If non-nil, \"ESC , Fe\" and \"ESC - Fe\" are used for inputting
27 Latin characters.")
28
29 ;; common global variables of internal use
30 (defvar _keyboard-first-byte_ nil
31 "Character buffer for the first byte of two-byte character.")
32 (defvar _keyboard-SS2_ nil
33 "Flag to indicate Single Shift SS2.")
34 (defvar _keyboard-SS3_ nil
35 "Flag to indicate Single Shift SS3.")
36 (defvar _keyboard-saved-local-map_ nil
37 "Saved local keymap.")
38 (defvar _saved-local-map-single-shift_ nil
39 "Saved single shift local map.")
40
41 (defvar _current-g0_ 0)
42 (defvar _current-g1_ nil)
43 (defvar _current-g2_ nil)
44 (defvar _current-g3_ nil)
45
46 (defconst local-map-iso nil
47 "Local keymap used while inputing ISO2022 code directly.")
48 (defconst local-map-shift-jis nil
49 "Local keymap used while inputing Shift-JIS code directly.")
50 (defconst local-map-big5 nil
51 "Local keymap used while inputing Big5 code directly.")
52
53 (defconst esc-dol-map nil "Keys to designate 94n or 96n charset.")
54 (defconst esc-openpar-map nil "Keys to designate 94 charset to GL.")
55 (defconst esc-closepar-map nil "Keys to designate 94 charset to GR.")
56 (defconst esc-comma-map nil "Keys to designate 96 charset to GL.")
57 (defconst esc-minus-map nil "Keys to designate 96 charset to GR.")
58 (defconst esc-dol-openpar-map nil "Keys to designate 94n charset to GL.")
59 (defconst esc-dol-closepar-map nil "Keys to designate 94n charset to GR.")
60 (defconst esc-dol-comma-map nil "Keys to designate 96n charset to GL.")
61 (defconst esc-dol-minus-map nil "Keys to designate 96n charset to GR.")
62
63 ;;;###autoload
64 (defun set-keyboard-coding-system (codesys)
65 "Set variable keyboard-coding-system to CODESYS and modify keymap for it."
66 (interactive "zKeyboard-coding-system: ")
67 (let ((type (coding-system-type codesys)))
68 (cond ((eq type 'shift-jis)
69 (set-keyboard-coding-system-shift-jis))
70 ((eq type 'iso2022)
71 (set-keyboard-coding-system-iso2022 codesys))
72 ((eq type 'big5)
73 (set-keyboard-coding-system-big5))
74 (t
75 (error "Direct input of code %s is not supported." codesys)))))
76
77 (defsubst keyboard-define-key (map key command)
78 (define-key map (char-to-string key) command t))
79
80 (defun keyboard-set-input-mode (value)
81 (let ((mode (current-input-mode)))
82 ;; current-input-mode returns (INTERRUPT FLOW META QUIT-CHAR)
83 ;; set META to value.
84 (setcar (nthcdr 2 mode) value)
85 (apply (function set-input-mode) mode)))
86
87
88 (defun keyboard-select-keymap (&rest maps)
89 (or (nth (get-code-type keyboard-coding-system) maps)
90 (error "invalid keyboard-coding-system")))
91
92 (defun keyboard-self-insert-do-insert (char)
93 (self-insert-internal char)
94 (check-auto-fill))
95
96 (defun keyboard-use-local-map-do-insert (map)
97 (use-local-map map))
98
99 (defun keyboard-current-local-map-do-insert ()
100 (current-local-map))
101
102 (defun keyboard-local-map-do-insert ()
103 (keyboard-select-keymap nil local-map-shift-jis local-map-iso local-map-big5))
104
105
106 (defconst keyboard-self-insert-function
107 (function keyboard-self-insert-do-insert))
108
109 (defconst keyboard-use-local-map-function
110 (function keyboard-use-local-map-do-insert))
111
112 (defconst keyboard-current-local-map-function
113 (function keyboard-current-local-map-do-insert))
114
115 (defconst keyboard-local-map-function
116 (function keyboard-local-map-do-insert))
117
118 (defun keyboard-self-insert (char)
119 (funcall keyboard-self-insert-function char))
120
121 (defun keyboard-current-local-map ()
122 (funcall keyboard-current-local-map-function))
123
124 (defun keyboard-use-local-map (map)
125 (funcall keyboard-use-local-map-function map))
126
127 (defun keyboard-local-map ()
128 (funcall keyboard-local-map-function))
129
130
131 (defun keyboard-reset-state ()
132 (setq _keyboard-first-byte_ nil
133 _keyboard-SS2_ nil
134 _keyboard-SS3_ nil))
135
136 (defun keyboard-define-global-map-iso (map)
137 (let ((i 160))
138 (while (< i 256)
139 (keyboard-define-key map i 'self-insert-iso)
140 (setq i (1+ i))))
141 (define-key map "\216" 'keyboard-SS2 t)
142 (define-key map "\217" 'keyboard-SS3 t)
143 (define-key map "\e(" 'esc-openpar-prefix)
144 (define-key map "\e)" 'esc-closepar-prefix)
145 (if keyboard-allow-latin-input
146 (progn
147 (define-key map "\e," 'esc-comma-prefix)
148 (define-key map "\e-" 'esc-minus-prefix)))
149 (define-key map "\e$" 'esc-dol-prefix))
150
151 (defun keyboard-define-local-map-iso (map)
152 (let ((i 33))
153 (while (< i 127)
154 (keyboard-define-key map i 'self-insert-iso)
155 (setq i (1+ i)))))
156
157 (defun set-keyboard-coding-system-iso2022 (code)
158 (setq _current-g0_ (coding-system-charset code 0))
159 (setq _current-g1_ (coding-system-charset code 1))
160 (setq _current-g2_ (coding-system-charset code 2))
161 (setq _current-g3_ (coding-system-charset code 3))
162 (if (null _current-g1_)
163 (keyboard-set-input-mode t) ; enable Meta-key
164 (keyboard-set-input-mode 0)) ; enable 8bit input as chars.
165 (let (i)
166 (setq i 160)
167 (while (< i 256)
168 (keyboard-define-key global-map i 'self-insert-iso)
169 (setq i (1+ i))))
170 (if local-map-iso nil
171 (setq local-map-iso (make-keymap))
172 (let (i map)
173 (setq i 33)
174 (while (< i 127)
175 (keyboard-define-key local-map-iso i 'self-insert-iso)
176 (setq i (1+ i)))
177 (setq map (current-global-map))
178 (setq i 161)
179 (while (< i 255)
180 (keyboard-define-key map i 'self-insert-iso)
181 (setq i (1+ i))))
182 (define-key local-map-iso "\C-g" 'mule-keyboard-quit))
183 (if esc-dol-map nil
184 (setq esc-dol-map (make-keymap)
185 esc-openpar-map (make-keymap)
186 esc-closepar-map (make-keymap)
187 esc-comma-map (make-keymap)
188 esc-minus-map (make-keymap)
189 esc-dol-openpar-map (make-keymap)
190 esc-dol-closepar-map (make-keymap)
191 esc-dol-comma-map (make-keymap)
192 esc-dol-minus-map (make-keymap))
193 (fset 'esc-dol-prefix esc-dol-map)
194 (fset 'esc-openpar-prefix esc-openpar-map)
195 (fset 'esc-closepar-prefix esc-closepar-map)
196 (fset 'esc-comma-prefix esc-comma-map)
197 (fset 'esc-minus-prefix esc-minus-map)
198 (fset 'esc-dol-openpar-prefix esc-dol-openpar-map)
199 (fset 'esc-dol-closepar-prefix esc-dol-closepar-map)
200 (fset 'esc-dol-comma-prefix esc-dol-comma-map)
201 (fset 'esc-dol-minus-prefix esc-dol-minus-map)
202 (define-key esc-dol-map "(" 'esc-dol-openpar-prefix)
203 (define-key esc-dol-map ")" 'esc-dol-closepar-prefix)
204 (define-key esc-dol-map "," 'esc-dol-comma-prefix)
205 (define-key esc-dol-map "-" 'esc-dol-minus-prefix)
206 (let (i)
207 (setq i ?0)
208 (while (< i ?`)
209 (keyboard-define-key esc-openpar-map i 'keyboard-designate-94-GL)
210 (keyboard-define-key esc-closepar-map i 'keyboard-designate-94-GR)
211 (keyboard-define-key esc-comma-map i 'keyboard-designate-96-GL)
212 (keyboard-define-key esc-minus-map i 'keyboard-designate-96-GR)
213 (keyboard-define-key esc-dol-map i 'keyboard-designate-94n-GL)
214 (keyboard-define-key esc-dol-openpar-map i 'keyboard-designate-94n-GL)
215 (keyboard-define-key esc-dol-closepar-map i 'keyboard-designate-94n-GR)
216 (keyboard-define-key esc-dol-comma-map i 'keyboard-designate-96n-GL)
217 (keyboard-define-key esc-dol-minus-map i 'keyboard-designate-96n-GR)
218 (setq i (1+ i)))))
219 (define-key global-map "\216" 'keyboard-SS2 t)
220 (define-key global-map "\217" 'keyboard-SS3 t)
221 (define-key esc-map "(" 'esc-openpar-prefix)
222 (define-key esc-map ")" 'esc-closepar-prefix)
223 (if keyboard-allow-latin-input
224 (progn
225 (define-key esc-map "," 'esc-comma-prefix)
226 (define-key esc-map "-" 'esc-minus-prefix)))
227 (define-key esc-map "$" 'esc-dol-prefix)
228 (keyboard-reset-state)
229 (setq keyboard-coding-system code)
230 )
231
232 (defun mule-keyboard-quit ()
233 (interactive)
234 (keyboard-reset-state)
235 (if _keyboard-saved-local-map_
236 (keyboard-use-local-map _keyboard-saved-local-map_))
237 (keyboard-quit))
238
239 (defun keyboard-change-local-map-for-iso ()
240 (if (eq (keyboard-current-local-map) (keyboard-local-map))
241 nil
242 (setq _keyboard-saved-local-map_ (keyboard-current-local-map))
243 (keyboard-use-local-map (keyboard-local-map))))
244
245 (defun keyboard-designate-94-GL ()
246 (interactive)
247 (if (and (coding-system-use-japanese-jisx0201-roman keyboard-coding-system)
248 (eq 'japanese-jisx0201-roman
249 (charset-from-attributes 1 94 last-command-char)))
250 (setq _current-g0_ 'ascii)
251 (setq _current-g0_ (charset-from-attributes 1 94 last-command-char)))
252 (if (eq _current-g0_ 'ascii)
253 (keyboard-use-local-map _keyboard-saved-local-map_)
254 (keyboard-change-local-map-for-iso)))
255
256 (defun keyboard-designate-94-GR ()
257 (interactive)
258 (setq _current-g1_ (charset-from-attributes 1 94 last-command-char)))
259
260 (defun keyboard-designate-96-GL ()
261 (interactive)
262 (setq _current-g0_ (charset-from-attributes 1 96 last-command-char))
263 (keyboard-change-local-map-for-iso))
264
265 (defun keyboard-designate-96-GR ()
266 (interactive)
267 (setq _current-g1_ (charset-from-attributes 1 96 last-command-char)))
268
269 (defun keyboard-designate-94n-GL ()
270 (interactive)
271 (if (and (coding-system-use-japanese-jisx0208-1978 keyboard-coding-system)
272 (eq 'japanese-jisx0208-1978
273 (charset-from-attributes 2 94 last-command-char)))
274 (setq _current-g0_ 'japanese-jisx0208)
275 (setq _current-g0_ (charset-from-attributes 2 94 last-command-char)))
276 (keyboard-change-local-map-for-iso))
277
278 (defun keyboard-designate-94n-GR ()
279 (interactive)
280 (setq _current-g1_ (charset-from-attributes 2 94 last-command-char)))
281
282 (defun keyboard-designate-96n-GL ()
283 (interactive)
284 (setq _current-g0_ (charset-from-attributes 2 96 last-command-char))
285 (keyboard-change-local-map-for-iso))
286
287 (defun keyboard-designate-96n-GR ()
288 (interactive)
289 (setq _current-g1_ (charset-from-attributes 2 96 last-command-char)))
290
291 (defun keyboard-SS2 ()
292 (interactive)
293 (setq _keyboard-SS2_ t)
294 (setq _saved-local-map-single-shift_ (keyboard-current-local-map))
295 (keyboard-change-local-map-for-iso))
296
297 (defun keyboard-SS3 ()
298 (interactive)
299 (setq _keyboard-SS3_ t)
300 (setq _saved-local-map-single-shift_ (keyboard-current-local-map))
301 (keyboard-change-local-map-for-iso))
302
303 (defun self-insert-iso ()
304 (interactive)
305 (let ((charset (cond (_keyboard-SS2_ _current-g2_)
306 (_keyboard-SS3_ _current-g3_)
307 ((< last-command-char 128) _current-g0_)
308 (t _current-g1_))))
309 (if (not charset) (mule-keyboard-quit))
310 (if (= (charset-dimension charset) 1)
311 (progn
312 (keyboard-self-insert (make-char charset last-command-char))
313 (if (or _keyboard-SS2_ _keyboard-SS3_)
314 (keyboard-use-local-map _saved-local-map-single-shift_))
315 (keyboard-reset-state))
316 (if _keyboard-first-byte_
317 (progn
318 (keyboard-self-insert (make-char charset _keyboard-first-byte_
319 last-command-char))
320 (if (or _keyboard-SS2_ _keyboard-SS3_)
321 (keyboard-use-local-map _saved-local-map-single-shift_))
322 (keyboard-reset-state))
323 (setq _keyboard-first-byte_ last-command-char)))))
324
325
326 (defun keyboard-define-global-map-shift-jis (map)
327 (let ((i 128))
328 (while (< i 160)
329 (keyboard-define-key map i 'self-insert-shift-jis-japanese)
330 (setq i (1+ i)))
331 (while (< i 224)
332 (keyboard-define-key map i 'self-insert-shift-jis-kana)
333 (setq i (1+ i)))
334 (while (< i 256)
335 (keyboard-define-key map i 'self-insert-shift-jis-japanese)
336 (setq i (1+ i)))))
337
338 (defun keyboard-define-local-map-shift-jis (map)
339 (let ((i 64))
340 (while (< i 256)
341 (keyboard-define-key map i 'self-insert-shift-jis-japanese2)
342 (setq i (1+ i)))))
343
344 (defun set-keyboard-coding-system-shift-jis ()
345 (keyboard-set-input-mode 0) ; enable 8bit input as chars
346 (keyboard-define-global-map-shift-jis global-map)
347 (if local-map-shift-jis
348 nil
349 (setq local-map-shift-jis (make-keymap))
350 (keyboard-define-local-map-shift-jis local-map-shift-jis)
351 (define-key local-map-shift-jis "\C-g" 'mule-keyboard-quit))
352 (setq _keyboard-first-byte_ nil)
353 (setq keyboard-coding-system 'shift-jis))
354
355 (defun self-insert-shift-jis-japanese ()
356 (interactive)
357 (setq _keyboard-first-byte_ last-command-char)
358 (setq _keyboard-saved-local-map_ (keyboard-current-local-map))
359 (keyboard-use-local-map (keyboard-local-map)))
360
361 (defun self-insert-shift-jis-japanese2 ()
362 (interactive)
363 (if _keyboard-first-byte_
364 (let ((char
365 (decode-shift-jis-char _keyboard-first-byte_ last-command-char)))
366 (keyboard-self-insert char)
367 (setq _keyboard-first-byte_ nil)))
368 (keyboard-use-local-map _keyboard-saved-local-map_))
369
370 (defun self-insert-shift-jis-kana ()
371 (interactive)
372 (keyboard-self-insert (make-char 'japanese-jisx0201-kana last-command-char)))
373
374
375 (defun keyboard-define-global-map-big5 (map)
376 (let ((i ?\xA1))
377 (while (< i ?\xFE)
378 (keyboard-define-key map i 'self-insert-big5-1)
379 (setq i (1+ i)))))
380
381 (defun keyboard-define-local-map-big5 (map)
382 (let ((i ?\x40))
383 (while (< i ?\x7F)
384 (keyboard-define-key map i 'self-insert-big5-2)
385 (setq i (1+ i)))
386 (setq i ?\xA1)
387 (while (< i ?\xFF)
388 (keyboard-define-key map i 'self-insert-big5-2)
389 (setq i (1+ i)))
390 ))
391
392 (defun set-keyboard-coding-system-big5 ()
393 (require 'chinese)
394 (keyboard-set-input-mode 0) ; enable 8bit input as chars
395 (keyboard-define-global-map-big5 global-map)
396 (if local-map-big5
397 nil
398 (setq local-map-big5 (make-keymap))
399 (keyboard-define-local-map-big5 local-map-big5)
400 (define-key local-map-big5 "\C-g" 'mule-keyboard-quit))
401 (setq _keyboard-first-byte_ 0)
402 (setq keyboard-coding-system 'big5))
403
404 (defun self-insert-big5-1 ()
405 (interactive)
406 (setq _keyboard-first-byte_ last-command-char)
407 (setq _keyboard-saved-local-map_ (keyboard-current-local-map))
408 (keyboard-use-local-map (keyboard-local-map)))
409
410 (defun self-insert-big5-2 ()
411 (interactive)
412 (if _keyboard-first-byte_
413 (progn
414 (keyboard-self-insert
415 (decode-big5-char _keyboard-first-byte_ last-command-char
416 'character))
417 (setq _keyboard-first-byte_ nil)))
418 (keyboard-use-local-map _keyboard-saved-local-map_))
419
420
421 (defun check-auto-fill ()
422 (if (and auto-fill-function (> (current-column) fill-column))
423 (funcall auto-fill-function)))