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