diff lisp/mule/mule-keyboard.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents
children 6608ceec7cf8
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/mule/mule-keyboard.el	Mon Aug 13 09:02:59 2007 +0200
@@ -0,0 +1,423 @@
+;;; mule-keyboard.el --- Direct input of multilingual chars from keyboard.
+
+;; Copyright (C) 1992 Free Software Foundation, Inc.
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the 
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; 92.3.5   created for Mule Ver.0.9.0 by K.Handa <handa@etl.go.jp>
+
+;;;###autoload
+(defvar keyboard-allow-latin-input nil
+  "If non-nil, \"ESC , Fe\" and \"ESC - Fe\" are used for inputting
+Latin characters.")
+
+;; common global variables of internal use
+(defvar _keyboard-first-byte_ nil
+  "Character buffer for the first byte of two-byte character.")
+(defvar _keyboard-SS2_ nil
+  "Flag to indicate Single Shift SS2.")
+(defvar _keyboard-SS3_ nil
+  "Flag to indicate Single Shift SS3.")
+(defvar _keyboard-saved-local-map_ nil
+  "Saved local keymap.")
+(defvar _saved-local-map-single-shift_ nil
+  "Saved single shift local map.")
+
+(defvar _current-g0_ 0)
+(defvar _current-g1_ nil)
+(defvar _current-g2_ nil)
+(defvar _current-g3_ nil)
+
+(defconst local-map-iso nil
+  "Local keymap used while inputing ISO2022 code directly.")
+(defconst local-map-shift-jis nil
+  "Local keymap used while inputing Shift-JIS code directly.")
+(defconst local-map-big5 nil
+  "Local keymap used while inputing Big5 code directly.")
+
+(defconst esc-dol-map nil "Keys to designate 94n or 96n charset.")
+(defconst esc-openpar-map nil "Keys to designate 94 charset to GL.")
+(defconst esc-closepar-map nil "Keys to designate 94 charset to GR.")
+(defconst esc-comma-map nil "Keys to designate 96 charset to GL.")
+(defconst esc-minus-map nil "Keys to designate 96 charset to GR.")
+(defconst esc-dol-openpar-map nil "Keys to designate 94n charset to GL.")
+(defconst esc-dol-closepar-map nil "Keys to designate 94n charset to GR.")
+(defconst esc-dol-comma-map nil "Keys to designate 96n charset to GL.")
+(defconst esc-dol-minus-map nil "Keys to designate 96n charset to GR.")
+
+;;;###autoload
+(defun set-keyboard-coding-system (codesys)
+  "Set variable keyboard-coding-system to CODESYS and modify keymap for it."
+  (interactive "zKeyboard-coding-system: ")
+  (let ((type (coding-system-type codesys)))
+    (cond ((eq type 'shift-jis)
+	   (set-keyboard-coding-system-shift-jis))
+	  ((eq type 'iso2022)
+	   (set-keyboard-coding-system-iso2022 codesys))
+	  ((eq type 'big5)
+	   (set-keyboard-coding-system-big5))
+	  (t
+	   (error "Direct input of code %s is not supported." codesys)))))
+
+(defsubst keyboard-define-key (map key command)
+  (define-key map (char-to-string key) command t))
+
+(defun keyboard-set-input-mode (value)
+  (let ((mode (current-input-mode)))
+    ;; current-input-mode returns (INTERRUPT FLOW META QUIT-CHAR)
+    ;; set META to value.
+    (setcar (nthcdr 2 mode) value)
+    (apply (function set-input-mode) mode)))
+
+
+(defun keyboard-select-keymap (&rest maps)
+  (or (nth (get-code-type keyboard-coding-system) maps)
+      (error "invalid keyboard-coding-system")))
+
+(defun keyboard-self-insert-do-insert (char)
+  (self-insert-internal char)
+  (check-auto-fill))
+
+(defun keyboard-use-local-map-do-insert (map)
+  (use-local-map map))
+
+(defun keyboard-current-local-map-do-insert ()
+  (current-local-map))
+
+(defun keyboard-local-map-do-insert ()
+  (keyboard-select-keymap nil local-map-shift-jis local-map-iso local-map-big5))
+
+
+(defconst keyboard-self-insert-function 
+  (function keyboard-self-insert-do-insert))
+
+(defconst keyboard-use-local-map-function 
+  (function keyboard-use-local-map-do-insert))
+
+(defconst keyboard-current-local-map-function 
+  (function keyboard-current-local-map-do-insert))
+
+(defconst keyboard-local-map-function 
+  (function keyboard-local-map-do-insert))
+
+(defun keyboard-self-insert (char)
+  (funcall keyboard-self-insert-function char))
+
+(defun keyboard-current-local-map ()
+  (funcall keyboard-current-local-map-function))
+
+(defun keyboard-use-local-map (map)
+  (funcall keyboard-use-local-map-function map))
+
+(defun keyboard-local-map ()
+  (funcall keyboard-local-map-function))
+
+
+(defun keyboard-reset-state ()
+  (setq _keyboard-first-byte_ nil
+	_keyboard-SS2_ nil
+	_keyboard-SS3_ nil))
+
+(defun keyboard-define-global-map-iso (map)
+  (let ((i 160))
+    (while (< i 256)
+      (keyboard-define-key map i 'self-insert-iso)
+      (setq i (1+ i))))
+  (define-key map "\216" 'keyboard-SS2 t)
+  (define-key map "\217" 'keyboard-SS3 t)
+  (define-key map "\e(" 'esc-openpar-prefix)
+  (define-key map "\e)" 'esc-closepar-prefix)
+  (if keyboard-allow-latin-input
+      (progn
+	(define-key map "\e," 'esc-comma-prefix)
+	(define-key map "\e-" 'esc-minus-prefix)))
+  (define-key map "\e$" 'esc-dol-prefix))
+
+(defun keyboard-define-local-map-iso (map)
+  (let ((i 33))
+    (while (< i 127)
+      (keyboard-define-key map i 'self-insert-iso)
+      (setq i (1+ i)))))
+
+(defun set-keyboard-coding-system-iso2022 (code)
+  (setq _current-g0_ (coding-system-charset code 0))
+  (setq _current-g1_ (coding-system-charset code 1))
+  (setq _current-g2_ (coding-system-charset code 2))
+  (setq _current-g3_ (coding-system-charset code 3))
+  (if (null _current-g1_)
+      (keyboard-set-input-mode t)	; enable Meta-key
+    (keyboard-set-input-mode 0))	; enable 8bit input as chars.
+  (let (i)
+    (setq i 160)
+    (while (< i 256)
+      (keyboard-define-key global-map i 'self-insert-iso)
+      (setq i (1+ i))))
+  (if local-map-iso nil
+    (setq local-map-iso (make-keymap))
+    (let (i map)
+      (setq i 33)
+      (while (< i 127)
+	(keyboard-define-key local-map-iso i 'self-insert-iso)
+	(setq i (1+ i)))
+      (setq map (current-global-map))
+      (setq i 161)
+      (while (< i 255)
+	(keyboard-define-key map i 'self-insert-iso)
+	(setq i (1+ i))))
+    (define-key local-map-iso "\C-g" 'mule-keyboard-quit))
+  (if esc-dol-map nil
+    (setq esc-dol-map (make-keymap)
+	  esc-openpar-map (make-keymap)
+	  esc-closepar-map (make-keymap)
+	  esc-comma-map (make-keymap)
+	  esc-minus-map (make-keymap)
+	  esc-dol-openpar-map (make-keymap)
+	  esc-dol-closepar-map (make-keymap)
+	  esc-dol-comma-map (make-keymap)
+	  esc-dol-minus-map (make-keymap))
+    (fset 'esc-dol-prefix esc-dol-map)
+    (fset 'esc-openpar-prefix esc-openpar-map)
+    (fset 'esc-closepar-prefix esc-closepar-map)
+    (fset 'esc-comma-prefix esc-comma-map)
+    (fset 'esc-minus-prefix esc-minus-map)
+    (fset 'esc-dol-openpar-prefix esc-dol-openpar-map)
+    (fset 'esc-dol-closepar-prefix esc-dol-closepar-map)
+    (fset 'esc-dol-comma-prefix esc-dol-comma-map)
+    (fset 'esc-dol-minus-prefix esc-dol-minus-map)
+    (define-key esc-dol-map "(" 'esc-dol-openpar-prefix)
+    (define-key esc-dol-map ")" 'esc-dol-closepar-prefix)
+    (define-key esc-dol-map "," 'esc-dol-comma-prefix)
+    (define-key esc-dol-map "-" 'esc-dol-minus-prefix)
+    (let (i)
+      (setq i ?0)
+      (while (< i ?`)
+	(keyboard-define-key esc-openpar-map i 'keyboard-designate-94-GL)
+	(keyboard-define-key esc-closepar-map i 'keyboard-designate-94-GR)
+	(keyboard-define-key esc-comma-map i 'keyboard-designate-96-GL)
+	(keyboard-define-key esc-minus-map i 'keyboard-designate-96-GR)
+	(keyboard-define-key esc-dol-map i 'keyboard-designate-94n-GL)
+	(keyboard-define-key esc-dol-openpar-map i 'keyboard-designate-94n-GL)
+	(keyboard-define-key esc-dol-closepar-map i 'keyboard-designate-94n-GR)
+	(keyboard-define-key esc-dol-comma-map i 'keyboard-designate-96n-GL)
+	(keyboard-define-key esc-dol-minus-map i 'keyboard-designate-96n-GR)
+	(setq i (1+ i)))))
+  (define-key global-map "\216" 'keyboard-SS2 t)
+  (define-key global-map "\217" 'keyboard-SS3 t)
+  (define-key esc-map "(" 'esc-openpar-prefix)
+  (define-key esc-map ")" 'esc-closepar-prefix)
+  (if keyboard-allow-latin-input
+      (progn
+	(define-key esc-map "," 'esc-comma-prefix)
+	(define-key esc-map "-" 'esc-minus-prefix)))
+  (define-key esc-map "$" 'esc-dol-prefix)
+  (keyboard-reset-state)
+  (setq keyboard-coding-system code)
+  )
+
+(defun mule-keyboard-quit ()
+  (interactive)
+  (keyboard-reset-state)
+  (if _keyboard-saved-local-map_
+      (keyboard-use-local-map _keyboard-saved-local-map_))
+  (keyboard-quit))
+
+(defun keyboard-change-local-map-for-iso ()
+  (if (eq (keyboard-current-local-map) (keyboard-local-map))
+      nil
+    (setq _keyboard-saved-local-map_ (keyboard-current-local-map))
+    (keyboard-use-local-map (keyboard-local-map))))
+
+(defun keyboard-designate-94-GL ()
+  (interactive)
+  (if (and (coding-system-use-japanese-jisx0201-roman keyboard-coding-system)
+	   (eq 'japanese-jisx0201-roman
+	       (charset-from-attributes 1 94 last-command-char)))
+      (setq _current-g0_ 'ascii)
+    (setq _current-g0_ (charset-from-attributes 1 94 last-command-char)))
+  (if (eq _current-g0_ 'ascii)
+      (keyboard-use-local-map _keyboard-saved-local-map_)
+    (keyboard-change-local-map-for-iso)))
+
+(defun keyboard-designate-94-GR ()
+  (interactive)
+  (setq _current-g1_ (charset-from-attributes 1 94 last-command-char)))
+
+(defun keyboard-designate-96-GL ()
+  (interactive)
+  (setq _current-g0_ (charset-from-attributes 1 96 last-command-char))
+  (keyboard-change-local-map-for-iso))
+
+(defun keyboard-designate-96-GR ()
+  (interactive)
+  (setq _current-g1_ (charset-from-attributes 1 96 last-command-char)))
+
+(defun keyboard-designate-94n-GL ()
+  (interactive)
+  (if (and (coding-system-use-japanese-jisx0208-1978 keyboard-coding-system)
+	   (eq 'japanese-jisx0208-1978
+	       (charset-from-attributes 2 94 last-command-char)))
+      (setq _current-g0_ 'japanese-jisx0208)
+    (setq _current-g0_ (charset-from-attributes 2 94 last-command-char)))
+  (keyboard-change-local-map-for-iso))
+
+(defun keyboard-designate-94n-GR ()
+  (interactive)
+  (setq _current-g1_ (charset-from-attributes 2 94 last-command-char)))
+
+(defun keyboard-designate-96n-GL ()
+  (interactive)
+  (setq _current-g0_ (charset-from-attributes 2 96 last-command-char))
+  (keyboard-change-local-map-for-iso))
+
+(defun keyboard-designate-96n-GR ()
+  (interactive)
+  (setq _current-g1_ (charset-from-attributes 2 96 last-command-char)))
+
+(defun keyboard-SS2 ()
+  (interactive)
+  (setq _keyboard-SS2_ t)
+  (setq _saved-local-map-single-shift_ (keyboard-current-local-map))
+  (keyboard-change-local-map-for-iso))
+
+(defun keyboard-SS3 ()
+  (interactive)
+  (setq _keyboard-SS3_ t)
+  (setq _saved-local-map-single-shift_ (keyboard-current-local-map))
+  (keyboard-change-local-map-for-iso))
+
+(defun self-insert-iso ()
+  (interactive)
+  (let ((charset (cond (_keyboard-SS2_ _current-g2_)
+		       (_keyboard-SS3_ _current-g3_)
+		       ((< last-command-char 128) _current-g0_)
+		       (t _current-g1_))))
+    (if (not charset) (mule-keyboard-quit))
+    (if (= (charset-dimension charset) 1)
+	(progn
+	  (keyboard-self-insert (make-char charset last-command-char))
+	  (if (or _keyboard-SS2_ _keyboard-SS3_)
+	      (keyboard-use-local-map _saved-local-map-single-shift_))
+	  (keyboard-reset-state))
+      (if _keyboard-first-byte_
+	  (progn
+	    (keyboard-self-insert (make-char charset _keyboard-first-byte_
+					     last-command-char))
+	    (if (or _keyboard-SS2_ _keyboard-SS3_)
+		(keyboard-use-local-map _saved-local-map-single-shift_))
+	    (keyboard-reset-state))
+	(setq _keyboard-first-byte_ last-command-char)))))
+
+
+(defun keyboard-define-global-map-shift-jis (map)
+  (let ((i 128))
+    (while (< i 160)
+      (keyboard-define-key map i 'self-insert-shift-jis-japanese)
+      (setq i (1+ i)))
+    (while (< i 224)
+      (keyboard-define-key map i 'self-insert-shift-jis-kana)
+      (setq i (1+ i)))
+    (while (< i 256)
+      (keyboard-define-key map i 'self-insert-shift-jis-japanese)
+      (setq i (1+ i)))))
+
+(defun keyboard-define-local-map-shift-jis (map)
+  (let ((i 64))
+    (while (< i 256)
+      (keyboard-define-key map i 'self-insert-shift-jis-japanese2)
+      (setq i (1+ i)))))
+
+(defun set-keyboard-coding-system-shift-jis ()
+  (keyboard-set-input-mode 0)		; enable 8bit input as chars
+  (keyboard-define-global-map-shift-jis global-map)
+  (if local-map-shift-jis 
+      nil
+    (setq local-map-shift-jis (make-keymap))
+    (keyboard-define-local-map-shift-jis local-map-shift-jis)
+    (define-key local-map-shift-jis "\C-g" 'mule-keyboard-quit))
+  (setq _keyboard-first-byte_ nil)
+  (setq keyboard-coding-system 'shift-jis))
+
+(defun self-insert-shift-jis-japanese ()
+  (interactive)
+  (setq _keyboard-first-byte_ last-command-char)
+  (setq _keyboard-saved-local-map_ (keyboard-current-local-map))
+  (keyboard-use-local-map (keyboard-local-map)))
+
+(defun self-insert-shift-jis-japanese2 ()
+  (interactive)
+  (if _keyboard-first-byte_
+      (let ((char
+	     (decode-shift-jis-char _keyboard-first-byte_ last-command-char)))
+	(keyboard-self-insert char)
+	(setq _keyboard-first-byte_ nil)))
+  (keyboard-use-local-map _keyboard-saved-local-map_))
+
+(defun self-insert-shift-jis-kana ()
+  (interactive)
+  (keyboard-self-insert (make-char 'japanese-jisx0201-kana last-command-char)))
+
+
+(defun keyboard-define-global-map-big5 (map)
+  (let ((i ?\xA1))
+    (while (< i ?\xFE)
+      (keyboard-define-key map i 'self-insert-big5-1)
+      (setq i (1+ i)))))
+
+(defun keyboard-define-local-map-big5 (map)
+  (let ((i ?\x40))
+    (while (< i ?\x7F)
+      (keyboard-define-key map i 'self-insert-big5-2)
+      (setq i (1+ i)))
+    (setq i ?\xA1)
+    (while (< i ?\xFF)
+      (keyboard-define-key map i 'self-insert-big5-2)
+      (setq i (1+ i)))
+    ))
+
+(defun set-keyboard-coding-system-big5 ()
+  (require 'chinese)
+  (keyboard-set-input-mode 0)		; enable 8bit input as chars
+  (keyboard-define-global-map-big5 global-map)
+  (if local-map-big5
+      nil
+    (setq local-map-big5 (make-keymap))
+    (keyboard-define-local-map-big5 local-map-big5)
+    (define-key local-map-big5 "\C-g" 'mule-keyboard-quit))
+  (setq _keyboard-first-byte_ 0)
+  (setq keyboard-coding-system 'big5))
+
+(defun self-insert-big5-1 ()
+  (interactive)
+  (setq _keyboard-first-byte_ last-command-char)
+  (setq _keyboard-saved-local-map_ (keyboard-current-local-map))
+  (keyboard-use-local-map (keyboard-local-map)))
+
+(defun self-insert-big5-2 ()
+  (interactive)
+  (if _keyboard-first-byte_
+      (progn
+	(keyboard-self-insert
+	 (decode-big5-char _keyboard-first-byte_ last-command-char
+			   'character))
+	(setq _keyboard-first-byte_ nil)))
+  (keyboard-use-local-map _keyboard-saved-local-map_))
+
+
+(defun check-auto-fill ()
+  (if (and auto-fill-function (> (current-column) fill-column))
+      (funcall auto-fill-function)))