;; 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.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(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)
(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
(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
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
(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)))
HCoop / bpt / emacs.git / blobdiff