Mercurial > emacs

comparison lisp/international/encoded-kb.el @ 56597:399c8a1fbe0b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
The following changes are to utilize key-translation-map instead of minor mode map. (encoded-kbd-iso2022-non-ascii-map): Delete it. (encoded-kbd-coding, encoded-kbd-handle-8bit): Delete them. (encoded-kbd-last-key): New function. (encoded-kbd-iso2022-single-shift): New function. (encoded-kbd-iso2022-designation) (encoded-kbd-self-insert-iso2022-7bit) (encoded-kbd-self-insert-iso2022-8bit) (encoded-kbd-self-insert-sjis, encoded-kbd-self-insert-big5) (encoded-kbd-self-insert-ccl): Make them suitable for bindings in key-translation-map. (encoded-kbd-setup-keymap): Setup key-translation-map. (saved-key-translation-map): New variable. (encoded-kbd-mode): Save/restore key-translation-map. Adjusted for the change of encoded-kbd-setup-keymap.
author Kenichi Handa <handa@m17n.org>
date Tue, 03 Aug 2004 12:06:47 +0000
parents 695cf19ef79e
children 3caaa79fcb7e
comparison
equal deleted inserted replaced
56596:5919ee79d487 56597:399c8a1fbe0b
22 22
23 ;;; Commentary: 23 ;;; Commentary:
24 24
25 ;;; Code: 25 ;;; Code:
26 26
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.
27 (defconst encoded-kbd-mode-map (make-sparse-keymap) 31 (defconst encoded-kbd-mode-map (make-sparse-keymap)
28 "Keymap for Encoded-kbd minor mode.") 32 "Keymap for Encoded-kbd minor mode.")
29 33
30 ;; Subsidiary keymaps for handling ISO2022 escape sequences. 34 ;; Subsidiary keymaps for handling ISO2022 escape sequences.
31 35
67 map) 71 map)
68 "Keymap for handling ISO2022 designation sequence in Encoded-kbd mode.") 72 "Keymap for handling ISO2022 designation sequence in Encoded-kbd mode.")
69 (fset 'encoded-kbd-iso2022-designation-prefix 73 (fset 'encoded-kbd-iso2022-designation-prefix
70 encoded-kbd-iso2022-designation-map) 74 encoded-kbd-iso2022-designation-map)
71 75
72 (defvar encoded-kbd-iso2022-non-ascii-map
73 (let ((map (make-keymap))
74 (i 32))
75 (while (< i 128)
76 (define-key map (char-to-string i) 'encoded-kbd-self-insert-iso2022-7bit)
77 (setq i (1+ i)))
78 (define-key map "\e" 'encoded-kbd-iso2022-esc-prefix)
79 (setq i 160)
80 (while (< i 256)
81 (define-key map (vector i) 'encoded-kbd-handle-8bit)
82 (setq i (1+ i)))
83 map)
84 "Keymap for handling non-ASCII character set in Encoded-kbd mode.")
85
86 ;; One of the symbols `sjis', `iso2022-7', `iso2022-8', or `big5' to
87 ;; denote what kind of coding-system we are now handling in
88 ;; Encoded-kbd mode.
89 (defvar encoded-kbd-coding nil)
90
91 ;; Keep information of designation state of ISO2022 encoding. When 76 ;; Keep information of designation state of ISO2022 encoding. When
92 ;; Encoded-kbd mode is on, this is set to a vector of length 4, the 77 ;; Encoded-kbd mode is on, this is set to a vector of length 4, the
93 ;; elements are character sets currently designated to graphic 78 ;; elements are character sets currently designated to graphic
94 ;; registers 0 thru 3. 79 ;; registers 0 thru 3.
95 80
102 ;; 2, and a single shifted graphic register number. 87 ;; 2, and a single shifted graphic register number.
103 88
104 (defvar encoded-kbd-iso2022-invocations nil) 89 (defvar encoded-kbd-iso2022-invocations nil)
105 (put 'encoded-kbd-iso2022-invocations 'permanent-local t) 90 (put 'encoded-kbd-iso2022-invocations 'permanent-local t)
106 91
107 (defun encoded-kbd-iso2022-designation () 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)
108 "Do ISO2022 designation according to the current key in Encoded-kbd mode. 97 "Do ISO2022 designation according to the current key in Encoded-kbd mode.
109 The following key sequence may cause multilingual text insertion." 98 The following key sequence may cause multilingual text insertion."
110 (interactive) 99 (let ((key-seq (this-single-command-keys))
111 (let ((key-seq (this-command-keys))
112 (prev-g0-charset (aref encoded-kbd-iso2022-designations 100 (prev-g0-charset (aref encoded-kbd-iso2022-designations
113 (aref encoded-kbd-iso2022-invocations 0))) 101 (aref encoded-kbd-iso2022-invocations 0)))
114 intermediate-char final-char 102 intermediate-char final-char
115 reg dimension chars charset) 103 reg dimension chars charset)
116 (if (= (length key-seq) 4) 104 (if (= (length key-seq) 4)
130 (setq intermediate-char (aref key-seq 1) 118 (setq intermediate-char (aref key-seq 1)
131 dimension 1 119 dimension 1
132 chars (if (< intermediate-char ?,) 94 96) 120 chars (if (< intermediate-char ?,) 94 96)
133 final-char (aref key-seq 2) 121 final-char (aref key-seq 2)
134 reg (mod intermediate-char 4)))) 122 reg (mod intermediate-char 4))))
135 (if (setq charset (iso-charset dimension chars final-char)) 123 (aset encoded-kbd-iso2022-designations reg
136 (aset encoded-kbd-iso2022-designations reg charset) 124 (iso-charset dimension chars final-char)))
137 (error "Character set of DIMENSION %s, CHARS %s, FINAL-CHAR `%c' is not supported" 125 "")
138 dimension chars final-char)) 126
139 127 (defun encoded-kbd-iso2022-single-shift (ignore)
140 (if (memq (aref encoded-kbd-iso2022-designations 128 (let ((char (encoded-kbd-last-key)))
141 (aref encoded-kbd-iso2022-invocations 0)) 129 (aset encoded-kbd-iso2022-invocations 2
142 '(ascii latin-jisx0201)) 130 (aref encoded-kbd-iso2022-designations
143 ;; Graphic plane 0 (0x20..0x7f) is for ASCII. We don't have 131 (if (= char ?\216) 2 3))))
144 ;; to handle characters in this range specially. 132 "")
145 (if (not (memq prev-g0-charset '(ascii latin-jisx0201))) 133
146 ;; We must exit recursive edit now. 134 (defun encoded-kbd-self-insert-iso2022-7bit (ignore)
147 (throw 'exit nil)) 135 (let ((char (encoded-kbd-last-key))
148 ;; Graphic plane 0 is for non-ASCII. 136 (charset (aref encoded-kbd-iso2022-designations
149 (if (memq prev-g0-charset '(ascii latin-jisx0201)) 137 (or (aref encoded-kbd-iso2022-invocations 2)
150 ;; We must handle keys specially. 138 (aref encoded-kbd-iso2022-invocations 0)))))
151 (let ((overriding-local-map encoded-kbd-iso2022-non-ascii-map))
152 (recursive-edit))))))
153
154 (defun encoded-kbd-handle-8bit ()
155 "Handle an 8-bit character entered in Encoded-kbd mode."
156 (interactive)
157 (cond ((eq encoded-kbd-coding 'iso2022-7)
158 (error "Can't handle the character code %d" last-command-char))
159
160 ((eq encoded-kbd-coding 'iso2022-8)
161 (cond ((= last-command-char ?\216)
162 (aset encoded-kbd-iso2022-invocations 2 2))
163
164 ((= last-command-char ?\217)
165 (aset encoded-kbd-iso2022-invocations 2 3))
166
167 ((>= last-command-char ?\240)
168 (encoded-kbd-self-insert-iso2022-8bit))
169
170 (t
171 (error "Can't handle the character code %d"
172 last-command-char))))
173
174 ((eq encoded-kbd-coding 'sjis)
175 (encoded-kbd-self-insert-sjis))
176
177 (t
178 (encoded-kbd-self-insert-big5))))
179
180 (defun encoded-kbd-self-insert-iso2022-7bit ()
181 (interactive)
182 (let* ((charset (aref encoded-kbd-iso2022-designations
183 (or (aref encoded-kbd-iso2022-invocations 2)
184 (aref encoded-kbd-iso2022-invocations 0))))
185 (char (if (= (charset-dimension charset) 1)
186 (make-char charset last-command-char)
187 (make-char charset last-command-char (read-char-exclusive)))))
188 (aset encoded-kbd-iso2022-invocations 2 nil) 139 (aset encoded-kbd-iso2022-invocations 2 nil)
189 (setq unread-command-events (cons char unread-command-events)))) 140 (vector (if (= (charset-dimension charset) 1)
190 141 (make-char charset char)
191 (defun encoded-kbd-self-insert-iso2022-8bit () 142 (make-char charset char (read-char-exclusive))))))
192 (interactive) 143
193 (cond 144 (defun encoded-kbd-self-insert-iso2022-8bit (ignore)
194 ((= last-command-char ?\216) ; SS2 (Single Shift 2) 145 (let ((char (encoded-kbd-last-key))
195 (aset encoded-kbd-iso2022-invocations 2 2)) 146 (charset (aref encoded-kbd-iso2022-designations
196 ((= last-command-char ?\217) ; SS3 (Single Shift 3) 147 (or (aref encoded-kbd-iso2022-invocations 2)
197 (aset encoded-kbd-iso2022-invocations 2 3)) 148 (aref encoded-kbd-iso2022-invocations 1)))))
198 (t 149 (aset encoded-kbd-iso2022-invocations 2 nil)
199 (let* ((charset (aref encoded-kbd-iso2022-designations 150 (vector (if (= (charset-dimension charset) 1)
200 (or (aref encoded-kbd-iso2022-invocations 2) 151 (make-char charset char)
201 (aref encoded-kbd-iso2022-invocations 1)))) 152 (make-char charset char (read-char-exclusive))))))
202 (char (if (= (charset-dimension charset) 1) 153
203 (make-char charset last-command-char) 154 (defun encoded-kbd-self-insert-sjis (ignore)
204 (make-char charset last-command-char 155 (let ((char (encoded-kbd-last-key)))
205 (read-char-exclusive))))) 156 (vector
206 (aset encoded-kbd-iso2022-invocations 2 nil) 157 (if (or (< char ?\xA0) (>= char ?\xE0))
207 (setq unread-command-events (cons char unread-command-events)))))) 158 (decode-sjis-char (+ (ash char 8) (read-char-exclusive)))
208 159 (make-char 'katakana-jisx0201 char)))))
209 (defun encoded-kbd-self-insert-sjis () 160
210 (interactive) 161 (defun encoded-kbd-self-insert-big5 (ignore)
211 (let ((char (if (or (< last-command-char ?\xA0) (>= last-command-char ?\xE0)) 162 (let ((char (encoded-kbd-last-key)))
212 (decode-sjis-char (+ (ash last-command-char 8) 163 (vector
213 (read-char-exclusive))) 164 (decode-big5-char (+ (ash char 8) (read-char-exclusive))))))
214 (make-char 'katakana-jisx0201 last-command-char)))) 165
215 (setq unread-command-events (cons char unread-command-events)))) 166 (defun encoded-kbd-self-insert-ccl (ignore)
216 167 (let ((str (char-to-string (encoded-kbd-last-key)))
217 (defun encoded-kbd-self-insert-big5 ()
218 (interactive)
219 (let ((char (decode-big5-char (+ (ash last-command-char 8)
220 (read-char-exclusive)))))
221 (setq unread-command-events (cons char unread-command-events))))
222
223 (defun encoded-kbd-self-insert-ccl ()
224 (interactive)
225 (let ((str (char-to-string last-command-char))
226 (ccl (car (aref (coding-system-spec (keyboard-coding-system)) 4))) 168 (ccl (car (aref (coding-system-spec (keyboard-coding-system)) 4)))
227 (vec [nil nil nil nil nil nil nil nil nil]) 169 (vec [nil nil nil nil nil nil nil nil nil])
228 result) 170 result)
229 (while (= (length (setq result (ccl-execute-on-string ccl vec str t))) 0) 171 (while (= (length (setq result (ccl-execute-on-string ccl vec str t))) 0)
230 (dotimes (i 9) (aset vec i nil)) 172 (dotimes (i 9) (aset vec i nil))
231 (setq str (format "%s%c" str (read-char-exclusive)))) 173 (setq str (format "%s%c" str (read-char-exclusive))))
232 (setq unread-command-events 174 (vector (aref result 0))))
233 (append result unread-command-events))))
234 175
235 (defun encoded-kbd-setup-keymap (coding) 176 (defun encoded-kbd-setup-keymap (coding)
236 ;; At first, reset the keymap. 177 ;; At first, reset the keymap.
237 (setcdr encoded-kbd-mode-map nil) 178 (define-key encoded-kbd-mode-map "\e" nil)
238 ;; Then setup the keymap according to the keyboard coding system. 179 ;; Then setup the keymap according to the keyboard coding system.
239 (cond 180 (cond
240 ((eq encoded-kbd-coding 'sjis) 181 ((eq (coding-system-type coding) 1) ; SJIS
241 (let ((i 128)) 182 (let ((i 128))
242 (while (< i 256) 183 (while (< i 256)
243 (define-key encoded-kbd-mode-map 184 (define-key encoded-kbd-mode-map
244 (vector i) 'encoded-kbd-self-insert-sjis) 185 (vector i) 'encoded-kbd-self-insert-sjis)
245 (setq i (1+ i))))) 186 (setq i (1+ i))))
246 187 8)
247 ((eq encoded-kbd-coding 'big5) 188
189 ((eq (coding-system-type coding) 3) ; Big5
248 (let ((i 161)) 190 (let ((i 161))
249 (while (< i 255) 191 (while (< i 255)
250 (define-key encoded-kbd-mode-map 192 (define-key encoded-kbd-mode-map
251 (vector i) 'encoded-kbd-self-insert-big5) 193 (vector i) 'encoded-kbd-self-insert-big5)
252 (setq i (1+ i))))) 194 (setq i (1+ i))))
253 195 8)
254 ((eq encoded-kbd-coding 'iso2022-7) 196
255 (define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix)) 197 ((eq (coding-system-type coding) 2) ; ISO-2022
256 198 (let ((flags (coding-system-flags coding))
257 ((eq encoded-kbd-coding 'iso2022-8) 199 use-designation)
258 (define-key encoded-kbd-mode-map 200 (if (aref flags 8)
259 (vector ?\216) 'encoded-kbd-self-insert-iso2022-8bit) 201 nil ; Don't support locking-shift.
260 (define-key encoded-kbd-mode-map 202 (setq encoded-kbd-iso2022-designations (make-vector 4 nil)
261 (vector ?\217) 'encoded-kbd-self-insert-iso2022-8bit) 203 encoded-kbd-iso2022-invocations (make-vector 3 nil))
262 (let ((i 160)) 204 (dotimes (i 4)
263 (while (< i 256) 205 (if (aref flags i)
264 (define-key encoded-kbd-mode-map 206 (if (charsetp (aref flags i))
265 (vector i) 'encoded-kbd-self-insert-iso2022-8bit) 207 (aset encoded-kbd-iso2022-designations
266 (setq i (1+ i))))) 208 i (aref flags i))
267 209 (setq use-designation t)
268 ((eq encoded-kbd-coding 'ccl) 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)
225 (dotimes (i 96)
226 (define-key key-translation-map
227 (vector (+ 32 i)) 'encoded-kbd-self-insert-iso2022-7bit)))
228 (if (aref flags 7)
229 t
230 (dotimes (i 96)
231 (define-key key-translation-map
232 (vector (+ 160 i)) 'encoded-kbd-self-insert-iso2022-8bit))
233 8))))
234
235 ((eq (coding-system-type coding) 4) ; CCL-base
269 (let ((valid-codes (or (coding-system-get coding 'valid-codes) 236 (let ((valid-codes (or (coding-system-get coding 'valid-codes)
270 '((128 . 255)))) 237 '((128 . 255))))
271 elt from to) 238 elt from to valid)
272 (while valid-codes 239 (while valid-codes
273 (setq elt (car valid-codes) valid-codes (cdr valid-codes)) 240 (setq elt (car valid-codes) valid-codes (cdr valid-codes))
274 (if (consp elt) 241 (if (consp elt)
275 (setq from (car elt) to (cdr elt)) 242 (setq from (car elt) to (cdr elt))
276 (setq from (setq to elt))) 243 (setq from (setq to elt)))
277 (while (<= from to) 244 (while (<= from to)
278 (if (>= from 128) 245 (if (>= from 128)
279 (define-key encoded-kbd-mode-map 246 (define-key key-translation-map
280 (vector from) 'encoded-kbd-self-insert-ccl)) 247 (vector from) 'encoded-kbd-self-insert-ccl))
281 (setq from (1+ from)))))) 248 (setq from (1+ from))))
249 8))
282 250
283 (t 251 (t
284 (error "Invalid value in encoded-kbd-coding: %s" encoded-kbd-coding)))) 252 nil)))
285 253
254 ;; key-translation-map at the time Encoded-kbd mode is turned on is
255 ;; saved here.
256 (defvar saved-key-translation-map nil)
286 257
287 ;; Input mode at the time Encoded-kbd mode is turned on is saved here. 258 ;; Input mode at the time Encoded-kbd mode is turned on is saved here.
288 (defvar saved-input-mode nil) 259 (defvar saved-input-mode nil)
289 260
290 (put 'encoded-kbd-mode 'permanent-local t) 261 (put 'encoded-kbd-mode 'permanent-local t)
299 270
300 In Encoded-kbd mode, a text sent from keyboard is accepted 271 In Encoded-kbd mode, a text sent from keyboard is accepted
301 as a multilingual text encoded in a coding system set by 272 as a multilingual text encoded in a coding system set by
302 \\[set-keyboard-coding-system]." 273 \\[set-keyboard-coding-system]."
303 :global t 274 :global t
304 ;; We must at first reset input-mode to the original. 275
305 (if saved-input-mode (apply 'set-input-mode saved-input-mode))
306 (if encoded-kbd-mode 276 (if encoded-kbd-mode
307 (let ((coding (keyboard-coding-system))) 277 ;; We are turning on Encoded-kbd mode.
308 (setq saved-input-mode (current-input-mode)) 278 (let ((coding (keyboard-coding-system))
309 (cond ((null coding) 279 result)
310 (setq encoded-kbd-mode nil) 280 (or saved-key-translation-map
311 (error "No coding system for keyboard input is set")) 281 (if (keymapp key-translation-map)
312 282 (setq saved-key-translation-map
313 ((= (coding-system-type coding) 1) ; SJIS 283 (copy-keymap key-translation-map))
314 (set-input-mode 284 (setq key-translation-map (make-sparse-keymap))))
315 (nth 0 saved-input-mode) (nth 1 saved-input-mode) 285 (or saved-input-mode
316 'use-8th-bit (nth 3 saved-input-mode)) 286 (setq saved-input-mode
317 (setq encoded-kbd-coding 'sjis)) 287 (current-input-mode)))
318 288 (setq result (and coding (encoded-kbd-setup-keymap coding)))
319 ((= (coding-system-type coding) 2) ; ISO2022 289 (if result
320 (if (aref (coding-system-flags coding) 7) ; 7-bit only 290 (if (eq result 8)
321 (setq encoded-kbd-coding 'iso2022-7) 291 (set-input-mode
322 (set-input-mode 292 (nth 0 saved-input-mode)
323 (nth 0 saved-input-mode) (nth 1 saved-input-mode) 293 (nth 1 saved-input-mode)
324 'use-8th-bit (nth 3 saved-input-mode)) 294 'use-8th-bit
325 (setq encoded-kbd-coding 'iso2022-8)) 295 (nth 3 saved-input-mode)))
326 (setq encoded-kbd-iso2022-designations (make-vector 4 nil)) 296 (setq encoded-kbd-mode nil
327 (let ((flags (coding-system-flags coding)) 297 saved-key-translation-map nil
328 (i 0)) 298 saved-input-mode nil)
329 (while (< i 4) 299 (error "Unsupported coding system in Encoded-kbd mode: %S"
330 (if (charsetp (aref flags i)) 300 coding)))
331 (aset encoded-kbd-iso2022-designations i 301
332 (aref flags i)) 302 ;; We are turning off Encoded-kbd mode.
333 (if (charsetp (car-safe (aref flags i))) 303 (setq key-translation-map saved-key-translation-map
334 (aset encoded-kbd-iso2022-designations i 304 saved-key-translation-map nil)
335 (car (aref flags i))))) 305 (apply 'set-input-mode saved-input-mode)
336 (setq i (1+ i)))) 306 (setq saved-input-mode nil)))
337 (setq encoded-kbd-iso2022-invocations (make-vector 3 nil))
338 (aset encoded-kbd-iso2022-invocations 0 0)
339 (aset encoded-kbd-iso2022-invocations 1 1))
340
341 ((= (coding-system-type coding) 3) ; BIG5
342 (set-input-mode
343 (nth 0 saved-input-mode) (nth 1 saved-input-mode)
344 'use-8th-bit (nth 3 saved-input-mode))
345 (setq encoded-kbd-coding 'big5))
346
347 ((= (coding-system-type coding) 4) ; CCL based coding
348 (set-input-mode
349 (nth 0 saved-input-mode) (nth 1 saved-input-mode)
350 'use-8th-bit (nth 3 saved-input-mode))
351 (setq encoded-kbd-coding 'ccl))
352
353 (t
354 (setq encoded-kbd-mode nil)
355 (error "Coding-system `%s' is not supported in Encoded-kbd mode"
356 (keyboard-coding-system))))
357 (encoded-kbd-setup-keymap coding))))
358 307
359 (provide 'encoded-kb) 308 (provide 'encoded-kb)
360 309
361 ;;; arch-tag: 76f0f9b3-65e7-45c3-b692-59509a87ad44 310 ;;; arch-tag: 76f0f9b3-65e7-45c3-b692-59509a87ad44
362 ;;; encoded-kb.el ends here 311 ;;; encoded-kb.el ends here