[Emacs-diffs] Changes to emacs/lisp/international/encoded-kb.el,v

[Miles Bader]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Miles Bader <miles>     08/02/01 16:01:31

Index: lisp/international/encoded-kb.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/international/encoded-kb.el,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -b -r1.43 -r1.44
--- lisp/international/encoded-kb.el    8 Jan 2008 20:46:05 -0000       1.43
+++ lisp/international/encoded-kb.el    1 Feb 2008 16:01:16 -0000       1.44
@@ -6,6 +6,9 @@
 ;;   2005, 2006, 2007, 2008
 ;;   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.
 
@@ -167,7 +170,7 @@
 
 (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)
@@ -175,12 +178,70 @@
       (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 (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 keymap
@@ -188,46 +249,53 @@
        (setq i (1+ i))))
     8)
 
-   ((eq (coding-system-type coding) 3) ; Big5
-    (let ((i 161))
-      (while (< i 255)
+   ((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 keymap
-         (vector i) 'encoded-kbd-self-insert-big5)
-       (setq i (1+ i))))
+           (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 keymap "\e" 'encoded-kbd-iso2022-esc-prefix))
-       (when (or (aref flags 2) (aref flags 3))
+       (when (or (aref designation 2) (aref designation 3))
          (define-key keymap
            [?\216] 'encoded-kbd-iso2022-single-shift)
          (define-key keymap
            [?\217] 'encoded-kbd-iso2022-single-shift))
-       (or (eq (aref flags 0) 'ascii)
+       (or (eq (aref designation 0) 'ascii)
            (dotimes (i 96)
              (define-key keymap
                (vector (+ 32 i)) 'encoded-kbd-self-insert-iso2022-7bit)))
-       (if (aref flags 7)
+       (if (memq '7-bit flags)
            t
          (dotimes (i 96)
            (define-key keymap
@@ -235,7 +303,7 @@
          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
@@ -250,6 +318,14 @@
          (setq from (1+ from))))
       8))
 
+   ((eq (coding-system-type coding) 'utf-8)
+    (let ((i #xC0))
+      (while (< i 256)
+       (define-key keymap
+         (vector i) 'encoded-kbd-self-insert-utf-8)
+       (setq i (1+ i))))
+    8)
+
    (t
     nil)))