comparison lisp/international/encoded-kb.el @ 89961:3fd4a5c21153

Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-29 Merge from lorentey@elte.hu--2004/emacs--multi-tty--0, emacs--cvs-trunk--0 Patches applied: * lorentey@elte.hu--2004/emacs--multi-tty--0--patch-224 Added sorted-doc to backup regex in lib-src. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-479 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-482 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-483 Build-in-place tweak * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-484 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-485 Update from CVS
author Miles Bader <miles@gnu.org>
date Tue, 10 Aug 2004 07:46:40 +0000
parents 68c22ea6027c 3caaa79fcb7e
children 5e9097d1ad99
comparison
equal deleted inserted replaced
89960:d79ab6afded5 89961:3fd4a5c21153
26 26
27 ;;; Commentary: 27 ;;; Commentary:
28 28
29 ;;; Code: 29 ;;; Code:
30 30
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.
31 (defconst encoded-kbd-mode-map (make-sparse-keymap) 35 (defconst encoded-kbd-mode-map (make-sparse-keymap)
32 "Keymap for Encoded-kbd minor mode.") 36 "Keymap for Encoded-kbd minor mode.")
33 37
34 ;; Subsidiary keymaps for handling ISO2022 escape sequences. 38 ;; Subsidiary keymaps for handling ISO2022 escape sequences.
35 39
71 map) 75 map)
72 "Keymap for handling ISO2022 designation sequence in Encoded-kbd mode.") 76 "Keymap for handling ISO2022 designation sequence in Encoded-kbd mode.")
73 (fset 'encoded-kbd-iso2022-designation-prefix 77 (fset 'encoded-kbd-iso2022-designation-prefix
74 encoded-kbd-iso2022-designation-map) 78 encoded-kbd-iso2022-designation-map)
75 79
76 (defvar encoded-kbd-iso2022-non-ascii-map
77 (let ((map (make-keymap))
78 (i 32))
79 (while (< i 128)
80 (define-key map (char-to-string i) 'encoded-kbd-self-insert-iso2022-7bit)
81 (setq i (1+ i)))
82 (define-key map "\e" 'encoded-kbd-iso2022-esc-prefix)
83 (setq i 160)
84 (while (< i 256)
85 (define-key map (vector i) 'encoded-kbd-handle-8bit)
86 (setq i (1+ i)))
87 map)
88 "Keymap for handling non-ASCII character set in Encoded-kbd mode.")
89
90 ;; One of the symbols `sjis', `iso2022-7', `iso2022-8', `big5', or
91 ;; `utf-8' to denote what kind of coding-system we are now handling in
92 ;; Encoded-kbd mode.
93 (defvar encoded-kbd-coding nil)
94
95 ;; Keep information of designation state of ISO2022 encoding. When 80 ;; Keep information of designation state of ISO2022 encoding. When
96 ;; Encoded-kbd mode is on, this is set to a vector of length 4, the 81 ;; Encoded-kbd mode is on, this is set to a vector of length 4, the
97 ;; elements are character sets currently designated to graphic 82 ;; elements are character sets currently designated to graphic
98 ;; registers 0 thru 3. 83 ;; registers 0 thru 3.
99 84
106 ;; 2, and a single shifted graphic register number. 91 ;; 2, and a single shifted graphic register number.
107 92
108 (defvar encoded-kbd-iso2022-invocations nil) 93 (defvar encoded-kbd-iso2022-invocations nil)
109 (put 'encoded-kbd-iso2022-invocations 'permanent-local t) 94 (put 'encoded-kbd-iso2022-invocations 'permanent-local t)
110 95
111 (defun encoded-kbd-iso2022-designation () 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)
112 "Do ISO2022 designation according to the current key in Encoded-kbd mode. 101 "Do ISO2022 designation according to the current key in Encoded-kbd mode.
113 The following key sequence may cause multilingual text insertion." 102 The following key sequence may cause multilingual text insertion."
114 (interactive) 103 (let ((key-seq (this-single-command-keys))
115 (let ((key-seq (this-command-keys))
116 (prev-g0-charset (aref encoded-kbd-iso2022-designations 104 (prev-g0-charset (aref encoded-kbd-iso2022-designations
117 (aref encoded-kbd-iso2022-invocations 0))) 105 (aref encoded-kbd-iso2022-invocations 0)))
118 intermediate-char final-char 106 intermediate-char final-char
119 reg dimension chars charset) 107 reg dimension chars charset)
120 (if (= (length key-seq) 4) 108 (if (= (length key-seq) 4)
134 (setq intermediate-char (aref key-seq 1) 122 (setq intermediate-char (aref key-seq 1)
135 dimension 1 123 dimension 1
136 chars (if (< intermediate-char ?,) 94 96) 124 chars (if (< intermediate-char ?,) 94 96)
137 final-char (aref key-seq 2) 125 final-char (aref key-seq 2)
138 reg (mod intermediate-char 4)))) 126 reg (mod intermediate-char 4))))
139 (if (setq charset (iso-charset dimension chars final-char)) 127 (aset encoded-kbd-iso2022-designations reg
140 (aset encoded-kbd-iso2022-designations reg charset) 128 (iso-charset dimension chars final-char)))
141 (error "Character set of DIMENSION %s, CHARS %s, FINAL-CHAR `%c' is not supported" 129 "")
142 dimension chars final-char)) 130
143 131 (defun encoded-kbd-iso2022-single-shift (ignore)
144 (if (memq (aref encoded-kbd-iso2022-designations 132 (let ((char (encoded-kbd-last-key)))
145 (aref encoded-kbd-iso2022-invocations 0)) 133 (aset encoded-kbd-iso2022-invocations 2
146 '(ascii latin-jisx0201)) 134 (aref encoded-kbd-iso2022-designations
147 ;; Graphic plane 0 (0x20..0x7f) is for ASCII. We don't have 135 (if (= char ?\216) 2 3))))
148 ;; to handle characters in this range specially. 136 "")
149 (if (not (memq prev-g0-charset '(ascii latin-jisx0201))) 137
150 ;; We must exit recursive edit now. 138 (defun encoded-kbd-self-insert-iso2022-7bit (ignore)
151 (throw 'exit nil)) 139 (let ((char (encoded-kbd-last-key))
152 ;; Graphic plane 0 is for non-ASCII. 140 (charset (aref encoded-kbd-iso2022-designations
153 (if (memq prev-g0-charset '(ascii latin-jisx0201)) 141 (or (aref encoded-kbd-iso2022-invocations 2)
154 ;; We must handle keys specially. 142 (aref encoded-kbd-iso2022-invocations 0)))))
155 (let ((overriding-local-map encoded-kbd-iso2022-non-ascii-map))
156 (recursive-edit))))))
157
158 (defun encoded-kbd-handle-8bit ()
159 "Handle an 8-bit character entered in Encoded-kbd mode."
160 (interactive)
161 (cond ((eq encoded-kbd-coding 'iso2022-7)
162 (error "Can't handle the character code %d" last-command-char))
163
164 ((eq encoded-kbd-coding 'iso2022-8)
165 (cond ((= last-command-char ?\216)
166 (aset encoded-kbd-iso2022-invocations 2 2))
167
168 ((= last-command-char ?\217)
169 (aset encoded-kbd-iso2022-invocations 2 3))
170
171 ((>= last-command-char ?\240)
172 (encoded-kbd-self-insert-iso2022-8bit 1))
173
174 (t
175 (error "Can't handle the character code %d"
176 last-command-char))))
177
178 ((eq encoded-kbd-coding 'sjis)
179 (encoded-kbd-self-insert-sjis))
180
181 (t
182 (encoded-kbd-self-insert-big5))))
183
184 (defun encoded-kbd-self-insert-iso2022-7bit ()
185 (interactive)
186 (let* ((charset (aref encoded-kbd-iso2022-designations
187 (or (aref encoded-kbd-iso2022-invocations 2)
188 (aref encoded-kbd-iso2022-invocations 0))))
189 (char (if (= (charset-dimension charset) 1)
190 (make-char charset last-command-char)
191 (make-char charset last-command-char (read-char-exclusive)))))
192 (aset encoded-kbd-iso2022-invocations 2 nil) 143 (aset encoded-kbd-iso2022-invocations 2 nil)
193 (setq unread-command-events (cons char unread-command-events)))) 144 (vector (if (= (charset-dimension charset) 1)
194 145 (make-char charset char)
195 (defun encoded-kbd-self-insert-iso2022-8bit (arg) 146 (make-char charset char (read-char-exclusive))))))
196 (interactive "p") 147
197 (cond 148 (defun encoded-kbd-self-insert-iso2022-8bit (ignore)
198 ((= last-command-char ?\216) ; SS2 (Single Shift 2) 149 (let ((char (encoded-kbd-last-key))
199 (aset encoded-kbd-iso2022-invocations 2 2)) 150 (charset (aref encoded-kbd-iso2022-designations
200 ((= last-command-char ?\217) ; SS3 (Single Shift 3) 151 (or (aref encoded-kbd-iso2022-invocations 2)
201 (aset encoded-kbd-iso2022-invocations 2 3)) 152 (aref encoded-kbd-iso2022-invocations 1)))))
202 (t 153 (aset encoded-kbd-iso2022-invocations 2 nil)
203 (let* ((charset (aref encoded-kbd-iso2022-designations 154 (vector (if (= (charset-dimension charset) 1)
204 (or (aref encoded-kbd-iso2022-invocations 2) 155 (make-char charset char)
205 (aref encoded-kbd-iso2022-invocations 1)))) 156 (make-char charset char (read-char-exclusive))))))
206 (char (if (= (charset-dimension charset) 1) 157
207 (make-char charset last-command-char) 158 (defun encoded-kbd-self-insert-sjis (ignore)
208 (make-char charset last-command-char 159 (let ((char (encoded-kbd-last-key)))
209 (read-char-exclusive))))) 160 (vector
210 (aset encoded-kbd-iso2022-invocations 2 nil) 161 (if (or (< char ?\xA0) (>= char ?\xE0))
211 ;; As simply setting unread-command-events may result in 162 (decode-sjis-char (+ (ash char 8) (read-char-exclusive)))
212 ;; infinite-loop for characters 160..255, this is a temporary 163 (make-char 'katakana-jisx0201 char)))))
213 ;; workaround until we found a better solution. 164
214 (let ((last-command-char char)) 165 (defun encoded-kbd-self-insert-big5 (ignore)
215 (self-insert-command arg)))))) 166 (let ((char (encoded-kbd-last-key)))
216 167 (vector
217 (defun encoded-kbd-self-insert-sjis () 168 (decode-big5-char (+ (ash char 8) (read-char-exclusive))))))
218 (interactive) 169
219 (let ((char (if (or (< last-command-char ?\xA0) (>= last-command-char ?\xE0)) 170 (defun encoded-kbd-self-insert-ccl (ignore)
220 (decode-sjis-char (+ (ash last-command-char 8) 171 (let ((str (char-to-string (encoded-kbd-last-key)))
221 (read-char-exclusive)))
222 (make-char 'katakana-jisx0201 last-command-char))))
223 (setq unread-command-events (cons char unread-command-events))))
224
225 (defun encoded-kbd-self-insert-big5 ()
226 (interactive)
227 (let ((char (decode-big5-char (+ (ash last-command-char 8)
228 (read-char-exclusive)))))
229 (setq unread-command-events (cons char unread-command-events))))
230
231 (defun encoded-kbd-self-insert-ccl ()
232 (interactive)
233 (let ((str (char-to-string last-command-char))
234 (ccl (coding-system-get (keyboard-coding-system) :ccl-decoder)) 172 (ccl (coding-system-get (keyboard-coding-system) :ccl-decoder))
235 (vec [nil nil nil nil nil nil nil nil nil]) 173 (vec [nil nil nil nil nil nil nil nil nil])
236 result) 174 result)
237 (while (= (length (setq result (ccl-execute-on-string ccl vec str t))) 0) 175 (while (= (length (setq result (ccl-execute-on-string ccl vec str t))) 0)
238 (dotimes (i 9) (aset vec i nil)) 176 (dotimes (i 9) (aset vec i nil))
239 (setq str (format "%s%c" str (read-char-exclusive)))) 177 (setq str (format "%s%c" str (read-char-exclusive))))
240 (setq unread-command-events 178 (vector (aref result 0))))
241 (append result unread-command-events))))
242 179
243 (defun encoded-kbd-self-insert-charset (arg) 180 (defun encoded-kbd-self-insert-charset (arg)
244 (interactive "p") 181 (interactive "p")
245 (let* ((charset-list 182 (let* ((charset-list
246 (coding-system-get (keyboard-coding-system) :charset-list)) 183 (coding-system-get (keyboard-coding-system) :charset-list))
274 (let ((last-command-char ch)) 211 (let ((last-command-char ch))
275 (self-insert-command arg)))) 212 (self-insert-command arg))))
276 213
277 (defun encoded-kbd-setup-keymap (coding) 214 (defun encoded-kbd-setup-keymap (coding)
278 ;; At first, reset the keymap. 215 ;; At first, reset the keymap.
279 (setcdr encoded-kbd-mode-map nil) 216 (define-key encoded-kbd-mode-map "\e" nil)
280 ;; Then setup the keymap according to the keyboard coding system. 217 ;; Then setup the keymap according to the keyboard coding system.
281 (cond 218 (cond
282 ((eq encoded-kbd-coding 'charset) 219 ((eq encoded-kbd-coding 'charset)
283 (let* ((charset (car (coding-system-get coding :charset-list))) 220 (let* ((charset (car (coding-system-get coding :charset-list)))
284 (code-space (get-charset-property charset :code-space)) 221 (code-space (get-charset-property charset :code-space))
287 (while (<= from to) 224 (while (<= from to)
288 (define-key encoded-kbd-mode-map 225 (define-key encoded-kbd-mode-map
289 (vector from) 'encoded-kbd-self-insert-charset) 226 (vector from) 'encoded-kbd-self-insert-charset)
290 (setq from (1+ from))))) 227 (setq from (1+ from)))))
291 228
292 ((eq encoded-kbd-coding 'sjis) 229 ((eq (coding-system-type coding) 1) ; SJIS
293 (let ((i 128)) 230 (let ((i 128))
294 (while (< i 256) 231 (while (< i 256)
295 (define-key encoded-kbd-mode-map 232 (define-key key-translation-map
296 (vector i) 'encoded-kbd-self-insert-sjis) 233 (vector i) 'encoded-kbd-self-insert-sjis)
297 (setq i (1+ i))))) 234 (setq i (1+ i))))
298 235 8)
299 ((eq encoded-kbd-coding 'big5) 236
237 ((eq (coding-system-type coding) 3) ; Big5
300 (let ((i 161)) 238 (let ((i 161))
301 (while (< i 255) 239 (while (< i 255)
302 (define-key encoded-kbd-mode-map 240 (define-key key-translation-map
303 (vector i) 'encoded-kbd-self-insert-big5) 241 (vector i) 'encoded-kbd-self-insert-big5)
304 (setq i (1+ i))))) 242 (setq i (1+ i))))
305 243 8)
306 ((eq encoded-kbd-coding 'iso2022-7) 244
307 (define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix)) 245 ((eq (coding-system-type coding) 2) ; ISO-2022
308 246 (let ((flags (coding-system-flags coding))
309 ((eq encoded-kbd-coding 'iso2022-8) 247 use-designation)
310 (define-key encoded-kbd-mode-map 248 (if (aref flags 8)
311 (vector ?\216) 'encoded-kbd-self-insert-iso2022-8bit) 249 nil ; Don't support locking-shift.
312 (define-key encoded-kbd-mode-map 250 (setq encoded-kbd-iso2022-designations (make-vector 4 nil)
313 (vector ?\217) 'encoded-kbd-self-insert-iso2022-8bit) 251 encoded-kbd-iso2022-invocations (make-vector 3 nil))
314 (let ((i 160)) 252 (dotimes (i 4)
315 (while (< i 256) 253 (if (aref flags i)
316 (define-key encoded-kbd-mode-map 254 (if (charsetp (aref flags i))
317 (vector i) 'encoded-kbd-self-insert-iso2022-8bit) 255 (aset encoded-kbd-iso2022-designations
318 (setq i (1+ i))))) 256 i (aref flags i))
319 257 (setq use-designation t)
320 ((eq encoded-kbd-coding 'ccl) 258 (if (charsetp (car-safe (aref flags i)))
259 (aset encoded-kbd-iso2022-designations
260 i (car (aref flags i)))))))
261 (aset encoded-kbd-iso2022-invocations 0 0)
262 (if (aref encoded-kbd-iso2022-designations 1)
263 (aset encoded-kbd-iso2022-invocations 1 1))
264 (when use-designation
265 (define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix)
266 (define-key key-translation-map "\e" 'encoded-kbd-iso2022-esc-prefix))
267 (when (or (aref flags 2) (aref flags 3))
268 (define-key key-translation-map
269 [?\216] 'encoded-kbd-iso2022-single-shift)
270 (define-key key-translation-map
271 [?\217] 'encoded-kbd-iso2022-single-shift))
272 (or (eq (aref flags 0) 'ascii)
273 (dotimes (i 96)
274 (define-key key-translation-map
275 (vector (+ 32 i)) 'encoded-kbd-self-insert-iso2022-7bit)))
276 (if (aref flags 7)
277 t
278 (dotimes (i 96)
279 (define-key key-translation-map
280 (vector (+ 160 i)) 'encoded-kbd-self-insert-iso2022-8bit))
281 8))))
282
283 ((eq (coding-system-type coding) 4) ; CCL-base
321 (let ((valid-codes (or (coding-system-get coding :valid) 284 (let ((valid-codes (or (coding-system-get coding :valid)
322 '((128 . 255)))) 285 '((128 . 255))))
323 elt from to) 286 elt from to valid)
324 (while valid-codes 287 (while valid-codes
325 (setq elt (car valid-codes) valid-codes (cdr valid-codes)) 288 (setq elt (car valid-codes) valid-codes (cdr valid-codes))
326 (if (consp elt) 289 (if (consp elt)
327 (setq from (car elt) to (cdr elt)) 290 (setq from (car elt) to (cdr elt))
328 (setq from (setq to elt))) 291 (setq from (setq to elt)))
329 (while (<= from to) 292 (while (<= from to)
330 (if (>= from 128) 293 (if (>= from 128)
331 (define-key encoded-kbd-mode-map 294 (define-key key-translation-map
332 (vector from) 'encoded-kbd-self-insert-ccl)) 295 (vector from) 'encoded-kbd-self-insert-ccl))
333 (setq from (1+ from)))))) 296 (setq from (1+ from))))
297 8))
334 298
335 ((eq encoded-kbd-coding 'utf-8) 299 ((eq encoded-kbd-coding 'utf-8)
336 (let ((i #xC0)) 300 (let ((i #xC0))
337 (while (< i 256) 301 (while (< i 256)
338 (define-key encoded-kbd-mode-map 302 (define-key encoded-kbd-mode-map
339 (vector i) 'encoded-kbd-self-insert-utf-8) 303 (vector i) 'encoded-kbd-self-insert-utf-8)
340 (setq i (1+ i))))) 304 (setq i (1+ i)))))
341 305
342 (t 306 (t
343 (error "Invalid value in encoded-kbd-coding: %s" encoded-kbd-coding)))) 307 nil)))
344 308
309 ;; key-translation-map at the time Encoded-kbd mode is turned on is
310 ;; saved here.
311 (defvar saved-key-translation-map nil)
345 312
346 ;; Input mode at the time Encoded-kbd mode is turned on is saved here. 313 ;; Input mode at the time Encoded-kbd mode is turned on is saved here.
347 (defvar saved-input-mode nil) 314 (defvar saved-input-mode nil)
348 315
349 (put 'encoded-kbd-mode 'permanent-local t) 316 (put 'encoded-kbd-mode 'permanent-local t)