diff options
Diffstat (limited to 'lisp/international/encoded-kb.el')
| -rw-r--r-- | lisp/international/encoded-kb.el | 122 |
1 files changed, 99 insertions, 23 deletions
diff --git a/lisp/international/encoded-kb.el b/lisp/international/encoded-kb.el index 3da034a05ed..2354e658282 100644 --- a/lisp/international/encoded-kb.el +++ b/lisp/international/encoded-kb.el @@ -4,6 +4,9 @@ ;; Copyright (C) 1995, 1997, 1998, 1999, 2000, 2001, 2004, 2005 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021 +;; Copyright (C) 2003 +;; National Institute of Advanced Industrial Science and Technology (AIST) +;; Registration Number H13PRO009 ;; This file is part of GNU Emacs. @@ -165,7 +168,7 @@ The following key sequence may cause multilingual text insertion." (defun encoded-kbd-self-insert-ccl (ignore) (let ((str (char-to-string (encoded-kbd-last-key))) - (ccl (car (aref (coding-system-spec (keyboard-coding-system)) 4))) + (ccl (coding-system-get (keyboard-coding-system) :ccl-decoder)) (vec [nil nil nil nil nil nil nil nil nil]) result) (while (= (length (setq result (ccl-execute-on-string ccl vec str t))) 0) @@ -173,12 +176,70 @@ The following key sequence may cause multilingual text insertion." (setq str (format "%s%c" str (read-char-exclusive)))) (vector (aref result 0)))) + +;; Decode list of codes in CODE-LIST by CHARSET and return the decoded +;; characters. If CODE-LIST is too short for the dimension of +;; CHARSET, read new codes and append them to the tail of CODE-LIST. +;; Return nil if CODE-LIST can't be decoded. + +(defun encoded-kbd-decode-code-list (charset code-list) + (let ((dimension (charset-dimension charset)) + code) + (while (> dimension (length code-list)) + (nconc code-list (list (read-char-exclusive)))) + (setq code (car code-list)) + (if (= dimension 1) + (decode-char charset code) + (setq code-list (cdr code-list) + code (logior (lsh code 8) (car code-list))) + (if (= dimension 2) + (decode-char charset code) + (setq code-list (cdr code-list) + code (logior (lsh code 8) (car code-list))) + (if (= dimension 3) + (decode-char charset code) + ;; As Emacs can't handle full 32-bit integer, we must give a + ;; cons of higher and lower 16-bit codes to decode-char. + (setq code (cons (lsh code -8) + (logior (lsh (car code-list) 8) (cadr code-list)))) + (decode-char charset code)))))) + +(defun encoded-kbd-self-insert-charset (ignore) + (let ((charset-list + (coding-system-get (keyboard-coding-system) :charset-list)) + (code-list (list (encoded-kbd-last-key))) + tail char) + (while (and charset-list (not char)) + (setq char (encoded-kbd-decode-code-list (car charset-list) code-list) + charset-list (cdr charset-list))) + (if char + (vector char) + (setq unread-command-events (cdr code-list)) + (vector (car code-list))))) + +(defun encoded-kbd-self-insert-utf-8 (arg) + (interactive "p") + (let ((char (encoded-kbd-last-key)) + len) + (cond ((< char #xE0) + (setq len 1 char (logand char #x1F))) + ((< char #xF0) + (setq len 2 char (logand char #x0F))) + ((< char #xF8) + (setq len 3 char (logand char #x07))) + (t + (setq len 4 char 0))) + (while (> len 0) + (setq char (logior (lsh char 6) (logand (read-char-exclusive) #x3F)) + len (1- len))) + (vector char))) + (defun encoded-kbd-setup-keymap (coding) ;; At first, reset the keymap. (define-key encoded-kbd-mode-map "\e" nil) ;; Then setup the keymap according to the keyboard coding system. (cond - ((eq (coding-system-type coding) 1) ; SJIS + ((eq (coding-system-type coding) 'shift-jis) (let ((i 128)) (while (< i 256) (define-key key-translation-map @@ -186,46 +247,53 @@ The following key sequence may cause multilingual text insertion." (setq i (1+ i)))) 8) - ((eq (coding-system-type coding) 3) ; Big5 - (let ((i 161)) - (while (< i 255) - (define-key key-translation-map - (vector i) 'encoded-kbd-self-insert-big5) - (setq i (1+ i)))) + ((eq (coding-system-type coding) 'charset) + (dolist (elt (mapcar + #'(lambda (x) + (let ((dim (charset-dimension x)) + (code-space (get-charset-property x :code-space))) + (cons (aref code-space (* (1- dim) 2)) + (aref code-space (1+ (* (1- dim) 2)))))) + (coding-system-get coding :charset-list))) + (let ((from (max (car elt) 128)) + (to (cdr elt))) + (while (<= from to) + (define-key key-translation-map + (vector from) 'encoded-kbd-self-insert-charset) + (setq from (1+ from))))) 8) - ((eq (coding-system-type coding) 2) ; ISO-2022 - (let ((flags (coding-system-flags coding)) - use-designation) - (if (aref flags 8) + ((eq (coding-system-type coding) 'iso-2022) + (let ((flags (coding-system-get coding :flags)) + (designation (coding-system-get coding :designation))) + (if (memq 'locking-shift flags) nil ; Don't support locking-shift. (setq encoded-kbd-iso2022-designations (make-vector 4 nil) encoded-kbd-iso2022-invocations (make-vector 3 nil)) (dotimes (i 4) - (if (aref flags i) - (if (charsetp (aref flags i)) + (if (aref designation i) + (if (charsetp (aref designation i)) (aset encoded-kbd-iso2022-designations - i (aref flags i)) - (setq use-designation t) - (if (charsetp (car-safe (aref flags i))) + i (aref designation i)) + (if (charsetp (car-safe (aref designation i))) (aset encoded-kbd-iso2022-designations - i (car (aref flags i))))))) + i (car (aref designation i))))))) (aset encoded-kbd-iso2022-invocations 0 0) (if (aref encoded-kbd-iso2022-designations 1) (aset encoded-kbd-iso2022-invocations 1 1)) - (when use-designation + (when (memq 'designation flags) (define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix) (define-key key-translation-map "\e" 'encoded-kbd-iso2022-esc-prefix)) - (when (or (aref flags 2) (aref flags 3)) + (when (or (aref designation 2) (aref designation 3)) (define-key key-translation-map [?\216] 'encoded-kbd-iso2022-single-shift) (define-key key-translation-map [?\217] 'encoded-kbd-iso2022-single-shift)) - (or (eq (aref flags 0) 'ascii) + (or (eq (aref designation 0) 'ascii) (dotimes (i 96) (define-key key-translation-map (vector (+ 32 i)) 'encoded-kbd-self-insert-iso2022-7bit))) - (if (aref flags 7) + (if (memq '7-bit flags) t (dotimes (i 96) (define-key key-translation-map @@ -233,7 +301,7 @@ The following key sequence may cause multilingual text insertion." 8)))) ((eq (coding-system-type coding) 4) ; CCL-base - (let ((valid-codes (or (coding-system-get coding 'valid-codes) + (let ((valid-codes (or (coding-system-get coding :valid) '((128 . 255)))) elt from to valid) (while valid-codes @@ -248,6 +316,14 @@ The following key sequence may cause multilingual text insertion." (setq from (1+ from)))) 8)) + ((eq (coding-system-type coding) 'utf-8) + (let ((i #xC0)) + (while (< i 256) + (define-key key-translation-map + (vector i) 'encoded-kbd-self-insert-utf-8) + (setq i (1+ i)))) + 8) + (t nil))) |