Mercurial > emacs
comparison lisp/international/encoded-kb.el @ 89483:2f877ed80fa6
*** empty log message ***
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Mon, 08 Sep 2003 12:53:41 +0000 |
parents | 375f2633d815 ab210513bef9 |
children | f786eb22f54c |
comparison
equal
deleted
inserted
replaced
88123:375f2633d815 | 89483:2f877ed80fa6 |
---|---|
1 ;;; encoded-kb.el --- handler to input multibyte characters encoded somehow | 1 ;;; encoded-kb.el --- handler to input multibyte characters encoded somehow |
2 | 2 |
3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. | 3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. |
4 ;; Licensed to the Free Software Foundation. | 4 ;; Licensed to the Free Software Foundation. |
5 ;; Copyright (C) 2002 Free Software Foundation, Inc. | |
6 ;; Copyright (C) 2003 | |
7 ;; National Institute of Advanced Industrial Science and Technology (AIST) | |
8 ;; Registration Number H13PRO009 | |
5 | 9 |
6 ;; This file is part of GNU Emacs. | 10 ;; This file is part of GNU Emacs. |
7 | 11 |
8 ;; GNU Emacs is free software; you can redistribute it and/or modify | 12 ;; 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 | 13 ;; it under the terms of the GNU General Public License as published by |
163 | 167 |
164 ((= last-command-char ?\217) | 168 ((= last-command-char ?\217) |
165 (aset encoded-kbd-iso2022-invocations 2 3)) | 169 (aset encoded-kbd-iso2022-invocations 2 3)) |
166 | 170 |
167 ((>= last-command-char ?\240) | 171 ((>= last-command-char ?\240) |
168 (encoded-kbd-self-insert-iso2022-8bit)) | 172 (encoded-kbd-self-insert-iso2022-8bit 1)) |
169 | 173 |
170 (t | 174 (t |
171 (error "Can't handle the character code %d" | 175 (error "Can't handle the character code %d" |
172 last-command-char)))) | 176 last-command-char)))) |
173 | 177 |
186 (make-char charset last-command-char) | 190 (make-char charset last-command-char) |
187 (make-char charset last-command-char (read-char-exclusive))))) | 191 (make-char charset last-command-char (read-char-exclusive))))) |
188 (aset encoded-kbd-iso2022-invocations 2 nil) | 192 (aset encoded-kbd-iso2022-invocations 2 nil) |
189 (setq unread-command-events (cons char unread-command-events)))) | 193 (setq unread-command-events (cons char unread-command-events)))) |
190 | 194 |
191 (defun encoded-kbd-self-insert-iso2022-8bit () | 195 (defun encoded-kbd-self-insert-iso2022-8bit (arg) |
192 (interactive) | 196 (interactive "p") |
193 (cond | 197 (cond |
194 ((= last-command-char ?\216) ; SS2 (Single Shift 2) | 198 ((= last-command-char ?\216) ; SS2 (Single Shift 2) |
195 (aset encoded-kbd-iso2022-invocations 2 2)) | 199 (aset encoded-kbd-iso2022-invocations 2 2)) |
196 ((= last-command-char ?\217) ; SS3 (Single Shift 3) | 200 ((= last-command-char ?\217) ; SS3 (Single Shift 3) |
197 (aset encoded-kbd-iso2022-invocations 2 3)) | 201 (aset encoded-kbd-iso2022-invocations 2 3)) |
202 (char (if (= (charset-dimension charset) 1) | 206 (char (if (= (charset-dimension charset) 1) |
203 (make-char charset last-command-char) | 207 (make-char charset last-command-char) |
204 (make-char charset last-command-char | 208 (make-char charset last-command-char |
205 (read-char-exclusive))))) | 209 (read-char-exclusive))))) |
206 (aset encoded-kbd-iso2022-invocations 2 nil) | 210 (aset encoded-kbd-iso2022-invocations 2 nil) |
207 (setq unread-command-events (cons char unread-command-events)))))) | 211 ;; As simply setting unread-command-events may result in |
212 ;; infinite-loop for characters 160..255, this is a temporary | |
213 ;; workaround until we found a better solution. | |
214 (let ((last-command-char char)) | |
215 (self-insert-command arg)))))) | |
208 | 216 |
209 (defun encoded-kbd-self-insert-sjis () | 217 (defun encoded-kbd-self-insert-sjis () |
210 (interactive) | 218 (interactive) |
211 (let ((char (if (or (< last-command-char ?\xA0) (>= last-command-char ?\xE0)) | 219 (let ((char (if (or (< last-command-char ?\xA0) (>= last-command-char ?\xE0)) |
212 (decode-sjis-char (+ (ash last-command-char 8) | 220 (decode-sjis-char (+ (ash last-command-char 8) |
221 (setq unread-command-events (cons char unread-command-events)))) | 229 (setq unread-command-events (cons char unread-command-events)))) |
222 | 230 |
223 (defun encoded-kbd-self-insert-ccl () | 231 (defun encoded-kbd-self-insert-ccl () |
224 (interactive) | 232 (interactive) |
225 (let ((str (char-to-string last-command-char)) | 233 (let ((str (char-to-string last-command-char)) |
226 (ccl (car (aref (coding-system-spec (keyboard-coding-system)) 4))) | 234 (ccl (coding-system-get (keyboard-coding-system) :ccl-decoder)) |
227 (vec [nil nil nil nil nil nil nil nil nil]) | 235 (vec [nil nil nil nil nil nil nil nil nil]) |
228 result) | 236 result) |
229 (while (= (length (setq result (ccl-execute-on-string ccl vec str t))) 0) | 237 (while (= (length (setq result (ccl-execute-on-string ccl vec str t))) 0) |
230 (dotimes (i 9) (aset vec i nil)) | 238 (dotimes (i 9) (aset vec i nil)) |
231 (setq str (format "%s%c" str (read-char-exclusive)))) | 239 (setq str (format "%s%c" str (read-char-exclusive)))) |
232 (setq unread-command-events | 240 (setq unread-command-events |
233 (append result unread-command-events)))) | 241 (append result unread-command-events)))) |
234 | 242 |
243 (defun encoded-kbd-self-insert-charset (arg) | |
244 (interactive "p") | |
245 (let* ((charset-list | |
246 (coding-system-get (keyboard-coding-system) :charset-list)) | |
247 (charset (car charset-list)) | |
248 ;; For the moment, we can assume that the length of CHARSET-LIST | |
249 ;; is 1, and the dimension of CHARSET is 1. | |
250 (c (decode-char charset last-command-char))) | |
251 (unless c | |
252 (error "Can't decode the code point %d by %s" | |
253 last-command-char charset)) | |
254 ;; As simply setting unread-command-events may result in | |
255 ;; infinite-loop for characters 160..255, this is a temporary | |
256 ;; workaround until we found a better solution. | |
257 (let ((last-command-char c)) | |
258 (self-insert-command arg)))) | |
259 | |
235 (defun encoded-kbd-setup-keymap (coding) | 260 (defun encoded-kbd-setup-keymap (coding) |
236 ;; At first, reset the keymap. | 261 ;; At first, reset the keymap. |
237 (setcdr encoded-kbd-mode-map nil) | 262 (setcdr encoded-kbd-mode-map nil) |
238 ;; Then setup the keymap according to the keyboard coding system. | 263 ;; Then setup the keymap according to the keyboard coding system. |
239 (cond | 264 (cond |
265 ((eq encoded-kbd-coding 'charset) | |
266 (let* ((charset (car (coding-system-get coding :charset-list))) | |
267 (code-space (get-charset-property charset :code-space)) | |
268 (from (max (aref code-space 0) 128)) | |
269 (to (aref code-space 1))) | |
270 (while (<= from to) | |
271 (define-key encoded-kbd-mode-map | |
272 (vector from) 'encoded-kbd-self-insert-charset) | |
273 (setq from (1+ from))))) | |
274 | |
240 ((eq encoded-kbd-coding 'sjis) | 275 ((eq encoded-kbd-coding 'sjis) |
241 (let ((i 128)) | 276 (let ((i 128)) |
242 (while (< i 256) | 277 (while (< i 256) |
243 (define-key encoded-kbd-mode-map | 278 (define-key encoded-kbd-mode-map |
244 (vector i) 'encoded-kbd-self-insert-sjis) | 279 (vector i) 'encoded-kbd-self-insert-sjis) |
264 (define-key encoded-kbd-mode-map | 299 (define-key encoded-kbd-mode-map |
265 (vector i) 'encoded-kbd-self-insert-iso2022-8bit) | 300 (vector i) 'encoded-kbd-self-insert-iso2022-8bit) |
266 (setq i (1+ i))))) | 301 (setq i (1+ i))))) |
267 | 302 |
268 ((eq encoded-kbd-coding 'ccl) | 303 ((eq encoded-kbd-coding 'ccl) |
269 (let ((valid-codes (or (coding-system-get coding 'valid-codes) | 304 (let ((valid-codes (or (coding-system-get coding :valid) |
270 '((128 . 255)))) | 305 '((128 . 255)))) |
271 elt from to) | 306 elt from to) |
272 (while valid-codes | 307 (while valid-codes |
273 (setq elt (car valid-codes) valid-codes (cdr valid-codes)) | 308 (setq elt (car valid-codes) valid-codes (cdr valid-codes)) |
274 (if (consp elt) | 309 (if (consp elt) |
308 (setq saved-input-mode (current-input-mode)) | 343 (setq saved-input-mode (current-input-mode)) |
309 (cond ((null coding) | 344 (cond ((null coding) |
310 (setq encoded-kbd-mode nil) | 345 (setq encoded-kbd-mode nil) |
311 (error "No coding system for keyboard input is set")) | 346 (error "No coding system for keyboard input is set")) |
312 | 347 |
313 ((= (coding-system-type coding) 1) ; SJIS | 348 ((eq (coding-system-type coding) 'shift-jis) |
314 (set-input-mode | 349 (set-input-mode |
315 (nth 0 saved-input-mode) (nth 1 saved-input-mode) | 350 (nth 0 saved-input-mode) (nth 1 saved-input-mode) |
316 'use-8th-bit (nth 3 saved-input-mode)) | 351 'use-8th-bit (nth 3 saved-input-mode)) |
317 (setq encoded-kbd-coding 'sjis)) | 352 (setq encoded-kbd-coding 'sjis)) |
318 | 353 |
319 ((= (coding-system-type coding) 2) ; ISO2022 | 354 ((eq (coding-system-type coding) 'iso-2022) |
320 (if (aref (coding-system-flags coding) 7) ; 7-bit only | 355 (if (memq '7-bit (coding-system-get coding :flags)) |
321 (setq encoded-kbd-coding 'iso2022-7) | 356 (setq encoded-kbd-coding 'iso2022-7) |
322 (set-input-mode | 357 (set-input-mode |
323 (nth 0 saved-input-mode) (nth 1 saved-input-mode) | 358 (nth 0 saved-input-mode) (nth 1 saved-input-mode) |
324 'use-8th-bit (nth 3 saved-input-mode)) | 359 'use-8th-bit (nth 3 saved-input-mode)) |
325 (setq encoded-kbd-coding 'iso2022-8)) | 360 (setq encoded-kbd-coding 'iso2022-8)) |
326 (setq encoded-kbd-iso2022-designations (make-vector 4 nil)) | 361 (setq encoded-kbd-iso2022-designations |
327 (let ((flags (coding-system-flags coding)) | 362 (coding-system-get coding :designation)) |
328 (i 0)) | |
329 (while (< i 4) | |
330 (if (charsetp (aref flags i)) | |
331 (aset encoded-kbd-iso2022-designations i | |
332 (aref flags i)) | |
333 (if (charsetp (car-safe (aref flags i))) | |
334 (aset encoded-kbd-iso2022-designations i | |
335 (car (aref flags i))))) | |
336 (setq i (1+ i)))) | |
337 (setq encoded-kbd-iso2022-invocations (make-vector 3 nil)) | 363 (setq encoded-kbd-iso2022-invocations (make-vector 3 nil)) |
338 (aset encoded-kbd-iso2022-invocations 0 0) | 364 (aset encoded-kbd-iso2022-invocations 0 0) |
339 (aset encoded-kbd-iso2022-invocations 1 1)) | 365 (aset encoded-kbd-iso2022-invocations 1 1)) |
340 | 366 |
341 ((= (coding-system-type coding) 3) ; BIG5 | 367 ((eq (coding-system-type coding) 'big5) |
342 (set-input-mode | 368 (set-input-mode |
343 (nth 0 saved-input-mode) (nth 1 saved-input-mode) | 369 (nth 0 saved-input-mode) (nth 1 saved-input-mode) |
344 'use-8th-bit (nth 3 saved-input-mode)) | 370 'use-8th-bit (nth 3 saved-input-mode)) |
345 (setq encoded-kbd-coding 'big5)) | 371 (setq encoded-kbd-coding 'big5)) |
346 | 372 |
347 ((= (coding-system-type coding) 4) ; CCL based coding | 373 ((eq (coding-system-type coding) 'ccl) |
348 (set-input-mode | 374 (set-input-mode |
349 (nth 0 saved-input-mode) (nth 1 saved-input-mode) | 375 (nth 0 saved-input-mode) (nth 1 saved-input-mode) |
350 'use-8th-bit (nth 3 saved-input-mode)) | 376 'use-8th-bit (nth 3 saved-input-mode)) |
351 (setq encoded-kbd-coding 'ccl)) | 377 (setq encoded-kbd-coding 'ccl)) |
378 | |
379 ((and (eq (coding-system-type coding) 'charset) | |
380 (let* ((charset-list (coding-system-get coding | |
381 :charset-list)) | |
382 (charset (car charset-list))) | |
383 (and (= (length charset-list) 1) | |
384 (= (charset-dimension charset) 1)))) | |
385 (set-input-mode | |
386 (nth 0 saved-input-mode) (nth 1 saved-input-mode) | |
387 'use-8th-bit (nth 3 saved-input-mode)) | |
388 (setq encoded-kbd-coding 'charset)) | |
352 | 389 |
353 (t | 390 (t |
354 (setq encoded-kbd-mode nil) | 391 (setq encoded-kbd-mode nil) |
355 (error "Coding-system `%s' is not supported in Encoded-kbd mode" | 392 (error "Coding-system `%s' is not supported in Encoded-kbd mode" |
356 (keyboard-coding-system)))) | 393 (keyboard-coding-system)))) |