Commit | Line | Data |
---|---|---|
60370d40 | 1 | ;;; encoded-kb.el --- handler to input multibyte characters encoded somehow |
4ed46869 | 2 | |
d4877ac1 GM |
3 | ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006 |
4 | ;; Free Software Foundation, Inc. | |
7976eda0 KH |
5 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
6 | ;; 2005, 2006 | |
2fd125a3 KH |
7 | ;; National Institute of Advanced Industrial Science and Technology (AIST) |
8 | ;; Registration Number H14PRO021 | |
4ed46869 KH |
9 | |
10 | ;; This file is part of GNU Emacs. | |
11 | ||
12 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 | ;; it under the terms of the GNU General Public License as published by | |
14 | ;; the Free Software Foundation; either version 2, or (at your option) | |
15 | ;; any later version. | |
16 | ||
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
369314dc | 23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
3a35cf56 LK |
24 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
25 | ;; Boston, MA 02110-1301, USA. | |
4ed46869 | 26 | |
60370d40 PJ |
27 | ;;; Commentary: |
28 | ||
29 | ;;; Code: | |
30 | ||
5dda46a3 KH |
31 | ;; Usually this map is empty (even if Encoded-kbd mode is on), but if |
32 | ;; the keyboard coding system is iso-2022-based, it defines dummy key | |
33 | ;; bindings for ESC $ ..., etc. so that those bindings in | |
34 | ;; key-translation-map take effect. | |
068b074e | 35 | (defconst encoded-kbd-mode-map (make-sparse-keymap) |
4ed46869 KH |
36 | "Keymap for Encoded-kbd minor mode.") |
37 | ||
4ed46869 KH |
38 | ;; Subsidiary keymaps for handling ISO2022 escape sequences. |
39 | ||
40 | (defvar encoded-kbd-iso2022-esc-map | |
41 | (let ((map (make-sparse-keymap))) | |
42 | (define-key map "$" 'encoded-kbd-iso2022-esc-dollar-prefix) | |
43 | (define-key map "(" 'encoded-kbd-iso2022-designation-prefix) | |
44 | (define-key map ")" 'encoded-kbd-iso2022-designation-prefix) | |
45 | (define-key map "," 'encoded-kbd-iso2022-designation-prefix) | |
46 | (define-key map "-" 'encoded-kbd-iso2022-designation-prefix) | |
4ed46869 KH |
47 | map) |
48 | "Keymap for handling ESC code in Encoded-kbd mode.") | |
f61d15a7 | 49 | (fset 'encoded-kbd-iso2022-esc-prefix encoded-kbd-iso2022-esc-map) |
4ed46869 KH |
50 | |
51 | (defvar encoded-kbd-iso2022-esc-dollar-map | |
52 | (let ((map (make-sparse-keymap))) | |
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-prefix) | |
56 | (define-key map "-" 'encoded-kbd-iso2022-designation-prefix) | |
57 | (define-key map "@" 'encoded-kbd-iso2022-designation) | |
58 | (define-key map "A" 'encoded-kbd-iso2022-designation) | |
59 | (define-key map "B" 'encoded-kbd-iso2022-designation) | |
4ed46869 | 60 | map) |
f61d15a7 | 61 | "Keymap for handling ESC $ sequence in Encoded-kbd mode.") |
4ed46869 KH |
62 | (fset 'encoded-kbd-iso2022-esc-dollar-prefix |
63 | encoded-kbd-iso2022-esc-dollar-map) | |
64 | ||
65 | (defvar encoded-kbd-iso2022-designation-map | |
66 | (let ((map (make-sparse-keymap)) | |
164edac8 KH |
67 | (l charset-list) |
68 | final-char) | |
f61d15a7 | 69 | (while l |
164edac8 | 70 | (setq final-char (charset-iso-final-char (car l))) |
71b898fe | 71 | (if (> final-char 0) |
164edac8 KH |
72 | (define-key map (char-to-string final-char) |
73 | 'encoded-kbd-iso2022-designation)) | |
f61d15a7 | 74 | (setq l (cdr l))) |
4ed46869 KH |
75 | map) |
76 | "Keymap for handling ISO2022 designation sequence in Encoded-kbd mode.") | |
77 | (fset 'encoded-kbd-iso2022-designation-prefix | |
78 | encoded-kbd-iso2022-designation-map) | |
79 | ||
068b074e KH |
80 | ;; Keep information of designation state of ISO2022 encoding. When |
81 | ;; Encoded-kbd mode is on, this is set to a vector of length 4, the | |
82 | ;; elements are character sets currently designated to graphic | |
83 | ;; registers 0 thru 3. | |
4ed46869 KH |
84 | |
85 | (defvar encoded-kbd-iso2022-designations nil) | |
4ed46869 KH |
86 | (put 'encoded-kbd-iso2022-designations 'permanent-local t) |
87 | ||
068b074e KH |
88 | ;; Keep information of invocation state of ISO2022 encoding. When |
89 | ;; Encoded-kbd mode is on, this is set to a vector of length 3, | |
90 | ;; graphic register numbers currently invoked to graphic plane 1 and | |
91 | ;; 2, and a single shifted graphic register number. | |
4ed46869 KH |
92 | |
93 | (defvar encoded-kbd-iso2022-invocations nil) | |
4ed46869 KH |
94 | (put 'encoded-kbd-iso2022-invocations 'permanent-local t) |
95 | ||
5dda46a3 KH |
96 | (defsubst encoded-kbd-last-key () |
97 | (let ((keys (this-single-command-keys))) | |
98 | (aref keys (1- (length keys))))) | |
99 | ||
100 | (defun encoded-kbd-iso2022-designation (ignore) | |
e8dd0160 | 101 | "Do ISO2022 designation according to the current key in Encoded-kbd mode. |
4ed46869 | 102 | The following key sequence may cause multilingual text insertion." |
5dda46a3 | 103 | (let ((key-seq (this-single-command-keys)) |
a0d4676a KH |
104 | (prev-g0-charset (aref encoded-kbd-iso2022-designations |
105 | (aref encoded-kbd-iso2022-invocations 0))) | |
4ed46869 KH |
106 | intermediate-char final-char |
107 | reg dimension chars charset) | |
f61d15a7 KH |
108 | (if (= (length key-seq) 4) |
109 | ;; ESC $ <intermediate-char> <final-char> | |
110 | (setq intermediate-char (aref key-seq 2) | |
4ed46869 KH |
111 | dimension 2 |
112 | chars (if (< intermediate-char ?,) 94 96) | |
f61d15a7 | 113 | final-char (aref key-seq 3) |
4ed46869 KH |
114 | reg (mod intermediate-char 4)) |
115 | (if (= (aref key-seq 1) ?$) | |
f61d15a7 | 116 | ;; ESC $ <final-char> |
4ed46869 KH |
117 | (setq dimension 2 |
118 | chars 94 | |
f61d15a7 | 119 | final-char (aref key-seq 2) |
4ed46869 | 120 | reg 0) |
f61d15a7 KH |
121 | ;; ESC <intermediate-char> <final-char> |
122 | (setq intermediate-char (aref key-seq 1) | |
4ed46869 KH |
123 | dimension 1 |
124 | chars (if (< intermediate-char ?,) 94 96) | |
f61d15a7 | 125 | final-char (aref key-seq 2) |
4ed46869 | 126 | reg (mod intermediate-char 4)))) |
5dda46a3 KH |
127 | (aset encoded-kbd-iso2022-designations reg |
128 | (iso-charset dimension chars final-char))) | |
129 | "") | |
130 | ||
131 | (defun encoded-kbd-iso2022-single-shift (ignore) | |
132 | (let ((char (encoded-kbd-last-key))) | |
e1a050dc | 133 | (aset encoded-kbd-iso2022-invocations 2 (if (= char ?\216) 2 3))) |
5dda46a3 KH |
134 | "") |
135 | ||
136 | (defun encoded-kbd-self-insert-iso2022-7bit (ignore) | |
137 | (let ((char (encoded-kbd-last-key)) | |
138 | (charset (aref encoded-kbd-iso2022-designations | |
139 | (or (aref encoded-kbd-iso2022-invocations 2) | |
140 | (aref encoded-kbd-iso2022-invocations 0))))) | |
4ed46869 | 141 | (aset encoded-kbd-iso2022-invocations 2 nil) |
5dda46a3 KH |
142 | (vector (if (= (charset-dimension charset) 1) |
143 | (make-char charset char) | |
144 | (make-char charset char (read-char-exclusive)))))) | |
145 | ||
146 | (defun encoded-kbd-self-insert-iso2022-8bit (ignore) | |
147 | (let ((char (encoded-kbd-last-key)) | |
148 | (charset (aref encoded-kbd-iso2022-designations | |
149 | (or (aref encoded-kbd-iso2022-invocations 2) | |
150 | (aref encoded-kbd-iso2022-invocations 1))))) | |
151 | (aset encoded-kbd-iso2022-invocations 2 nil) | |
152 | (vector (if (= (charset-dimension charset) 1) | |
153 | (make-char charset char) | |
154 | (make-char charset char (read-char-exclusive)))))) | |
155 | ||
156 | (defun encoded-kbd-self-insert-sjis (ignore) | |
157 | (let ((char (encoded-kbd-last-key))) | |
158 | (vector | |
159 | (if (or (< char ?\xA0) (>= char ?\xE0)) | |
160 | (decode-sjis-char (+ (ash char 8) (read-char-exclusive))) | |
161 | (make-char 'katakana-jisx0201 char))))) | |
162 | ||
163 | (defun encoded-kbd-self-insert-big5 (ignore) | |
164 | (let ((char (encoded-kbd-last-key))) | |
165 | (vector | |
166 | (decode-big5-char (+ (ash char 8) (read-char-exclusive)))))) | |
167 | ||
168 | (defun encoded-kbd-self-insert-ccl (ignore) | |
169 | (let ((str (char-to-string (encoded-kbd-last-key))) | |
4c8d5b4b | 170 | (ccl (car (aref (coding-system-spec (keyboard-coding-system)) 4))) |
81a23e88 | 171 | (vec [nil nil nil nil nil nil nil nil nil]) |
4c8d5b4b KH |
172 | result) |
173 | (while (= (length (setq result (ccl-execute-on-string ccl vec str t))) 0) | |
81a23e88 KH |
174 | (dotimes (i 9) (aset vec i nil)) |
175 | (setq str (format "%s%c" str (read-char-exclusive)))) | |
5dda46a3 | 176 | (vector (aref result 0)))) |
068b074e KH |
177 | |
178 | (defun encoded-kbd-setup-keymap (coding) | |
179 | ;; At first, reset the keymap. | |
5dda46a3 | 180 | (define-key encoded-kbd-mode-map "\e" nil) |
068b074e KH |
181 | ;; Then setup the keymap according to the keyboard coding system. |
182 | (cond | |
5dda46a3 | 183 | ((eq (coding-system-type coding) 1) ; SJIS |
068b074e KH |
184 | (let ((i 128)) |
185 | (while (< i 256) | |
af1781ac | 186 | (define-key key-translation-map |
068b074e | 187 | (vector i) 'encoded-kbd-self-insert-sjis) |
5dda46a3 KH |
188 | (setq i (1+ i)))) |
189 | 8) | |
068b074e | 190 | |
5dda46a3 | 191 | ((eq (coding-system-type coding) 3) ; Big5 |
068b074e KH |
192 | (let ((i 161)) |
193 | (while (< i 255) | |
af1781ac | 194 | (define-key key-translation-map |
068b074e | 195 | (vector i) 'encoded-kbd-self-insert-big5) |
5dda46a3 KH |
196 | (setq i (1+ i)))) |
197 | 8) | |
198 | ||
199 | ((eq (coding-system-type coding) 2) ; ISO-2022 | |
200 | (let ((flags (coding-system-flags coding)) | |
201 | use-designation) | |
202 | (if (aref flags 8) | |
203 | nil ; Don't support locking-shift. | |
204 | (setq encoded-kbd-iso2022-designations (make-vector 4 nil) | |
205 | encoded-kbd-iso2022-invocations (make-vector 3 nil)) | |
206 | (dotimes (i 4) | |
207 | (if (aref flags i) | |
208 | (if (charsetp (aref flags i)) | |
209 | (aset encoded-kbd-iso2022-designations | |
210 | i (aref flags i)) | |
211 | (setq use-designation t) | |
212 | (if (charsetp (car-safe (aref flags i))) | |
213 | (aset encoded-kbd-iso2022-designations | |
214 | i (car (aref flags i))))))) | |
215 | (aset encoded-kbd-iso2022-invocations 0 0) | |
216 | (if (aref encoded-kbd-iso2022-designations 1) | |
217 | (aset encoded-kbd-iso2022-invocations 1 1)) | |
218 | (when use-designation | |
219 | (define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix) | |
220 | (define-key key-translation-map "\e" 'encoded-kbd-iso2022-esc-prefix)) | |
221 | (when (or (aref flags 2) (aref flags 3)) | |
222 | (define-key key-translation-map | |
223 | [?\216] 'encoded-kbd-iso2022-single-shift) | |
224 | (define-key key-translation-map | |
225 | [?\217] 'encoded-kbd-iso2022-single-shift)) | |
226 | (or (eq (aref flags 0) 'ascii) | |
227 | (dotimes (i 96) | |
228 | (define-key key-translation-map | |
229 | (vector (+ 32 i)) 'encoded-kbd-self-insert-iso2022-7bit))) | |
230 | (if (aref flags 7) | |
231 | t | |
232 | (dotimes (i 96) | |
233 | (define-key key-translation-map | |
234 | (vector (+ 160 i)) 'encoded-kbd-self-insert-iso2022-8bit)) | |
235 | 8)))) | |
236 | ||
237 | ((eq (coding-system-type coding) 4) ; CCL-base | |
068b074e | 238 | (let ((valid-codes (or (coding-system-get coding 'valid-codes) |
4c8d5b4b | 239 | '((128 . 255)))) |
5dda46a3 | 240 | elt from to valid) |
068b074e KH |
241 | (while valid-codes |
242 | (setq elt (car valid-codes) valid-codes (cdr valid-codes)) | |
243 | (if (consp elt) | |
244 | (setq from (car elt) to (cdr elt)) | |
245 | (setq from (setq to elt))) | |
246 | (while (<= from to) | |
247 | (if (>= from 128) | |
5dda46a3 | 248 | (define-key key-translation-map |
068b074e | 249 | (vector from) 'encoded-kbd-self-insert-ccl)) |
5dda46a3 KH |
250 | (setq from (1+ from)))) |
251 | 8)) | |
068b074e KH |
252 | |
253 | (t | |
5dda46a3 | 254 | nil))) |
068b074e | 255 | |
5dda46a3 KH |
256 | ;; key-translation-map at the time Encoded-kbd mode is turned on is |
257 | ;; saved here. | |
258 | (defvar saved-key-translation-map nil) | |
068b074e | 259 | |
586ec68a KH |
260 | ;; Input mode at the time Encoded-kbd mode is turned on is saved here. |
261 | (defvar saved-input-mode nil) | |
262 | ||
ff14aafb | 263 | (put 'encoded-kbd-mode 'permanent-local t) |
f61d15a7 | 264 | ;;;###autoload |
ff14aafb | 265 | (define-minor-mode encoded-kbd-mode |
4ed46869 | 266 | "Toggle Encoded-kbd minor mode. |
586ec68a | 267 | With arg, turn Encoded-kbd mode on if and only if arg is positive. |
4ed46869 | 268 | |
a0d4676a | 269 | You should not turn this mode on manually, instead use the command |
f7e5a632 | 270 | \\[set-keyboard-coding-system] which turns on or off this mode |
a0d4676a KH |
271 | automatically. |
272 | ||
273 | In Encoded-kbd mode, a text sent from keyboard is accepted | |
274 | as a multilingual text encoded in a coding system set by | |
f7e5a632 | 275 | \\[set-keyboard-coding-system]." |
64a2e5ca | 276 | :global t :group 'keyboard :group 'mule |
5dda46a3 | 277 | |
4ed46869 | 278 | (if encoded-kbd-mode |
5dda46a3 KH |
279 | ;; We are turning on Encoded-kbd mode. |
280 | (let ((coding (keyboard-coding-system)) | |
281 | result) | |
282 | (or saved-key-translation-map | |
283 | (if (keymapp key-translation-map) | |
284 | (setq saved-key-translation-map | |
285 | (copy-keymap key-translation-map)) | |
286 | (setq key-translation-map (make-sparse-keymap)))) | |
287 | (or saved-input-mode | |
288 | (setq saved-input-mode | |
289 | (current-input-mode))) | |
290 | (setq result (and coding (encoded-kbd-setup-keymap coding))) | |
291 | (if result | |
292 | (if (eq result 8) | |
293 | (set-input-mode | |
294 | (nth 0 saved-input-mode) | |
295 | (nth 1 saved-input-mode) | |
296 | 'use-8th-bit | |
297 | (nth 3 saved-input-mode))) | |
298 | (setq encoded-kbd-mode nil | |
299 | saved-key-translation-map nil | |
300 | saved-input-mode nil) | |
301 | (error "Unsupported coding system in Encoded-kbd mode: %S" | |
302 | coding))) | |
303 | ||
304 | ;; We are turning off Encoded-kbd mode. | |
305 | (setq key-translation-map saved-key-translation-map | |
306 | saved-key-translation-map nil) | |
307 | (apply 'set-input-mode saved-input-mode) | |
308 | (setq saved-input-mode nil))) | |
4ed46869 | 309 | |
9c93c95a MR |
310 | (provide 'encoded-kb) |
311 | ||
ab5796a9 | 312 | ;;; arch-tag: 76f0f9b3-65e7-45c3-b692-59509a87ad44 |
4ed46869 | 313 | ;;; encoded-kb.el ends here |