Mercurial > emacs

comparison lisp/international/encoded-kb.el @ 89483:2f877ed80fa6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
*** 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))))