1 ;;; encoded-kb.el --- handler to input multibyte characters encoded somehow
3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995, 1997, 1998, 1999, 2000, 2001, 2004, 2005
5 ;; National Institute of Advanced Industrial Science and Technology (AIST)
6 ;; Registration Number H14PRO021
8 ;; This file is part of GNU Emacs.
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)
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.
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 the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
29 ;; Usually this map is empty (even if Encoded-kbd mode is on), but if
30 ;; the keyboard coding system is iso-2022-based, it defines dummy key
31 ;; bindings for ESC $ ..., etc. so that those bindings in
32 ;; key-translation-map take effect.
33 (defconst encoded-kbd-mode-map
(make-sparse-keymap)
34 "Keymap for Encoded-kbd minor mode.")
36 ;; Subsidiary keymaps for handling ISO2022 escape sequences.
38 (defvar encoded-kbd-iso2022-esc-map
39 (let ((map (make-sparse-keymap)))
40 (define-key map
"$" 'encoded-kbd-iso2022-esc-dollar-prefix
)
41 (define-key map
"(" 'encoded-kbd-iso2022-designation-prefix
)
42 (define-key map
")" 'encoded-kbd-iso2022-designation-prefix
)
43 (define-key map
"," 'encoded-kbd-iso2022-designation-prefix
)
44 (define-key map
"-" 'encoded-kbd-iso2022-designation-prefix
)
46 "Keymap for handling ESC code in Encoded-kbd mode.")
47 (fset 'encoded-kbd-iso2022-esc-prefix encoded-kbd-iso2022-esc-map
)
49 (defvar encoded-kbd-iso2022-esc-dollar-map
50 (let ((map (make-sparse-keymap)))
51 (define-key map
"(" 'encoded-kbd-iso2022-designation-prefix
)
52 (define-key map
")" 'encoded-kbd-iso2022-designation-prefix
)
53 (define-key map
"," 'encoded-kbd-iso2022-designation-prefix
)
54 (define-key map
"-" 'encoded-kbd-iso2022-designation-prefix
)
55 (define-key map
"@" 'encoded-kbd-iso2022-designation
)
56 (define-key map
"A" 'encoded-kbd-iso2022-designation
)
57 (define-key map
"B" 'encoded-kbd-iso2022-designation
)
59 "Keymap for handling ESC $ sequence in Encoded-kbd mode.")
60 (fset 'encoded-kbd-iso2022-esc-dollar-prefix
61 encoded-kbd-iso2022-esc-dollar-map
)
63 (defvar encoded-kbd-iso2022-designation-map
64 (let ((map (make-sparse-keymap))
68 (setq final-char
(charset-iso-final-char (car l
)))
70 (define-key map
(char-to-string final-char
)
71 'encoded-kbd-iso2022-designation
))
74 "Keymap for handling ISO2022 designation sequence in Encoded-kbd mode.")
75 (fset 'encoded-kbd-iso2022-designation-prefix
76 encoded-kbd-iso2022-designation-map
)
78 ;; Keep information of designation state of ISO2022 encoding. When
79 ;; Encoded-kbd mode is on, this is set to a vector of length 4, the
80 ;; elements are character sets currently designated to graphic
81 ;; registers 0 thru 3.
83 (defvar encoded-kbd-iso2022-designations nil
)
84 (put 'encoded-kbd-iso2022-designations
'permanent-local t
)
86 ;; Keep information of invocation state of ISO2022 encoding. When
87 ;; Encoded-kbd mode is on, this is set to a vector of length 3,
88 ;; graphic register numbers currently invoked to graphic plane 1 and
89 ;; 2, and a single shifted graphic register number.
91 (defvar encoded-kbd-iso2022-invocations nil
)
92 (put 'encoded-kbd-iso2022-invocations
'permanent-local t
)
94 (defsubst encoded-kbd-last-key
()
95 (let ((keys (this-single-command-keys)))
96 (aref keys
(1- (length keys
)))))
98 (defun encoded-kbd-iso2022-designation (ignore)
99 "Do ISO2022 designation according to the current key in Encoded-kbd mode.
100 The following key sequence may cause multilingual text insertion."
101 (let ((key-seq (this-single-command-keys))
102 (prev-g0-charset (aref encoded-kbd-iso2022-designations
103 (aref encoded-kbd-iso2022-invocations
0)))
104 intermediate-char final-char
105 reg dimension chars charset
)
106 (if (= (length key-seq
) 4)
107 ;; ESC $ <intermediate-char> <final-char>
108 (setq intermediate-char
(aref key-seq
2)
110 chars
(if (< intermediate-char ?
,) 94 96)
111 final-char
(aref key-seq
3)
112 reg
(mod intermediate-char
4))
113 (if (= (aref key-seq
1) ?$
)
114 ;; ESC $ <final-char>
117 final-char
(aref key-seq
2)
119 ;; ESC <intermediate-char> <final-char>
120 (setq intermediate-char
(aref key-seq
1)
122 chars
(if (< intermediate-char ?
,) 94 96)
123 final-char
(aref key-seq
2)
124 reg
(mod intermediate-char
4))))
125 (aset encoded-kbd-iso2022-designations reg
126 (iso-charset dimension chars final-char
)))
129 (defun encoded-kbd-iso2022-single-shift (ignore)
130 (let ((char (encoded-kbd-last-key)))
131 (aset encoded-kbd-iso2022-invocations
2 (if (= char ?
\216) 2 3)))
134 (defun encoded-kbd-self-insert-iso2022-7bit (ignore)
135 (let ((char (encoded-kbd-last-key))
136 (charset (aref encoded-kbd-iso2022-designations
137 (or (aref encoded-kbd-iso2022-invocations
2)
138 (aref encoded-kbd-iso2022-invocations
0)))))
139 (aset encoded-kbd-iso2022-invocations
2 nil
)
140 (vector (if (= (charset-dimension charset
) 1)
141 (make-char charset char
)
142 (make-char charset char
(read-char-exclusive))))))
144 (defun encoded-kbd-self-insert-iso2022-8bit (ignore)
145 (let ((char (encoded-kbd-last-key))
146 (charset (aref encoded-kbd-iso2022-designations
147 (or (aref encoded-kbd-iso2022-invocations
2)
148 (aref encoded-kbd-iso2022-invocations
1)))))
149 (aset encoded-kbd-iso2022-invocations
2 nil
)
150 (vector (if (= (charset-dimension charset
) 1)
151 (make-char charset char
)
152 (make-char charset char
(read-char-exclusive))))))
154 (defun encoded-kbd-self-insert-sjis (ignore)
155 (let ((char (encoded-kbd-last-key)))
157 (if (or (< char ?
\xA0) (>= char ?
\xE0))
158 (decode-sjis-char (+ (ash char
8) (read-char-exclusive)))
159 (make-char 'katakana-jisx0201 char
)))))
161 (defun encoded-kbd-self-insert-big5 (ignore)
162 (let ((char (encoded-kbd-last-key)))
164 (decode-big5-char (+ (ash char
8) (read-char-exclusive))))))
166 (defun encoded-kbd-self-insert-ccl (ignore)
167 (let ((str (char-to-string (encoded-kbd-last-key)))
168 (ccl (car (aref (coding-system-spec (keyboard-coding-system)) 4)))
169 (vec [nil nil nil nil nil nil nil nil nil
])
171 (while (= (length (setq result
(ccl-execute-on-string ccl vec str t
))) 0)
172 (dotimes (i 9) (aset vec i nil
))
173 (setq str
(format "%s%c" str
(read-char-exclusive))))
174 (vector (aref result
0))))
176 (defun encoded-kbd-setup-keymap (coding)
177 ;; At first, reset the keymap.
178 (define-key encoded-kbd-mode-map
"\e" nil
)
179 ;; Then setup the keymap according to the keyboard coding system.
181 ((eq (coding-system-type coding
) 1) ; SJIS
184 (define-key key-translation-map
185 (vector i
) 'encoded-kbd-self-insert-sjis
)
189 ((eq (coding-system-type coding
) 3) ; Big5
192 (define-key key-translation-map
193 (vector i
) 'encoded-kbd-self-insert-big5
)
197 ((eq (coding-system-type coding
) 2) ; ISO-2022
198 (let ((flags (coding-system-flags coding
))
201 nil
; Don't support locking-shift.
202 (setq encoded-kbd-iso2022-designations
(make-vector 4 nil
)
203 encoded-kbd-iso2022-invocations
(make-vector 3 nil
))
206 (if (charsetp (aref flags i
))
207 (aset encoded-kbd-iso2022-designations
209 (setq use-designation t
)
210 (if (charsetp (car-safe (aref flags i
)))
211 (aset encoded-kbd-iso2022-designations
212 i
(car (aref flags i
)))))))
213 (aset encoded-kbd-iso2022-invocations
0 0)
214 (if (aref encoded-kbd-iso2022-designations
1)
215 (aset encoded-kbd-iso2022-invocations
1 1))
216 (when use-designation
217 (define-key encoded-kbd-mode-map
"\e" 'encoded-kbd-iso2022-esc-prefix
)
218 (define-key key-translation-map
"\e" 'encoded-kbd-iso2022-esc-prefix
))
219 (when (or (aref flags
2) (aref flags
3))
220 (define-key key-translation-map
221 [?
\216] 'encoded-kbd-iso2022-single-shift
)
222 (define-key key-translation-map
223 [?
\217] 'encoded-kbd-iso2022-single-shift
))
224 (or (eq (aref flags
0) 'ascii
)
226 (define-key key-translation-map
227 (vector (+ 32 i
)) 'encoded-kbd-self-insert-iso2022-7bit
)))
231 (define-key key-translation-map
232 (vector (+ 160 i
)) 'encoded-kbd-self-insert-iso2022-8bit
))
235 ((eq (coding-system-type coding
) 4) ; CCL-base
236 (let ((valid-codes (or (coding-system-get coding
'valid-codes
)
240 (setq elt
(car valid-codes
) valid-codes
(cdr valid-codes
))
242 (setq from
(car elt
) to
(cdr elt
))
243 (setq from
(setq to elt
)))
246 (define-key key-translation-map
247 (vector from
) 'encoded-kbd-self-insert-ccl
))
248 (setq from
(1+ from
))))
254 ;; key-translation-map at the time Encoded-kbd mode is turned on is
256 (defvar saved-key-translation-map nil
)
258 ;; Input mode at the time Encoded-kbd mode is turned on is saved here.
259 (defvar saved-input-mode nil
)
261 (put 'encoded-kbd-mode
'permanent-local t
)
263 (define-minor-mode encoded-kbd-mode
264 "Toggle Encoded-kbd minor mode.
265 With arg, turn Encoded-kbd mode on if and only if arg is positive.
267 You should not turn this mode on manually, instead use the command
268 \\[set-keyboard-coding-system] which turns on or off this mode
271 In Encoded-kbd mode, a text sent from keyboard is accepted
272 as a multilingual text encoded in a coding system set by
273 \\[set-keyboard-coding-system]."
274 :global t
:group
'keyboard
:group
'mule
277 ;; We are turning on Encoded-kbd mode.
278 (let ((coding (keyboard-coding-system))
280 (or saved-key-translation-map
281 (if (keymapp key-translation-map
)
282 (setq saved-key-translation-map
283 (copy-keymap key-translation-map
))
284 (setq key-translation-map
(make-sparse-keymap))))
286 (setq saved-input-mode
287 (current-input-mode)))
288 (setq result
(and coding
(encoded-kbd-setup-keymap coding
)))
292 (nth 0 saved-input-mode
)
293 (nth 1 saved-input-mode
)
295 (nth 3 saved-input-mode
)))
296 (setq encoded-kbd-mode nil
297 saved-key-translation-map nil
298 saved-input-mode nil
)
299 (error "Unsupported coding system in Encoded-kbd mode: %S"
302 ;; We are turning off Encoded-kbd mode.
303 (setq key-translation-map saved-key-translation-map
304 saved-key-translation-map nil
)
305 (apply 'set-input-mode saved-input-mode
)
306 (setq saved-input-mode nil
)))
308 (provide 'encoded-kb
)
310 ;;; arch-tag: 76f0f9b3-65e7-45c3-b692-59509a87ad44
311 ;;; encoded-kb.el ends here