]> code.delx.au - gnu-emacs/blobdiff - lisp/language/korea-util.el
Merged in changes from CVS trunk.
[gnu-emacs] / lisp / language / korea-util.el
index c9ca349776d984d1f4b66b87c7812233e0841abf..222832022ac6e8469fd34a5389ef92a37cdacef3 100644 (file)
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
+;;; Commentary:
+
 ;;; Code:
 
 ;;;###autoload
-(defvar default-korean-keyboard ""
+(defvar default-korean-keyboard
+  (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") ""))
+      "3"
+    "")
   "*The kind of Korean keyboard for Korean input method.
 \"\" for 2, \"3\" for 3.")
 
         (activate-input-method (concat "korean-hanja"
                                        default-korean-keyboard)))))
 
-;; Information for exiting Korean environment.
-(defvar exit-korean-environment-data nil)
+;; The following three commands are set in isearch-mode-map.
 
-;;;###autoload
-(defun setup-korean-environment ()
-  "Setup multilingual environment (MULE) for Korean."
+(defun isearch-toggle-korean-input-method ()
   (interactive)
-  (setup-english-environment)
-  (setq coding-category-iso-8-2 'korean-iso-8bit)
-
-  (set-coding-priority
-   '(coding-category-iso-7
-     coding-category-iso-8-2
-     coding-category-iso-8-1))
-
-  (set-default-coding-systems 'korean-iso-8bit)
-
-  (setq default-input-method "korean-hangul")
+  (let ((overriding-terminal-local-map nil))
+    (toggle-korean-input-method))
+  (setq isearch-input-method-function input-method-function
+       isearch-input-method-local-p t)
+  (setq input-method-function nil)
+  (isearch-update))
+
+(defun isearch-hangul-switch-symbol-ksc ()
+  (interactive)
+  (let ((overriding-terminal-local-map nil))
+    (quail-hangul-switch-symbol-ksc))
+  (setq isearch-input-method-function input-method-function
+       isearch-input-method-local-p t)
+  (setq input-method-function nil)
+  (isearch-update))
+
+(defun isearch-hangul-switch-hanja ()
+  (interactive)
+  (let ((overriding-terminal-local-map nil))
+    (quail-hangul-switch-hanja))
+  (setq isearch-input-method-function input-method-function
+       isearch-input-method-local-p t)
+  (setq input-method-function nil)
+  (isearch-update))
+
+;; Information for setting and exiting Korean environment.
+(defvar korean-key-bindings
+  `((global [?\S- ] toggle-korean-input-method nil)
+    (global [C-f9] quail-hangul-switch-symbol-ksc nil)
+    (global [f9]  quail-hangul-switch-hanja nil)
+    (,isearch-mode-map [?\S- ] isearch-toggle-korean-input-method nil)
+    (,isearch-mode-map [C-f9] isearch-hangul-switch-symbol-ksc nil)
+    (,isearch-mode-map [f9] isearch-hangul-switch-hanja nil)))
 
-  (let ((key-bindings '(([?\S- ] . toggle-korean-input-method)
-                       ([C-f9] . quail-hangul-switch-symbol-ksc)
-                       ([f9] . quail-hangul-switch-hanja))))
+;;;###autoload
+(defun setup-korean-environment-internal ()
+  (let ((key-bindings korean-key-bindings))
     (while key-bindings
-      (let ((prev-binding (global-key-binding (car (car key-bindings)))))
-       (setq exit-korean-environment-data
-             (cons (cons (car (car key-bindings)) prev-binding)
-                   exit-korean-environment-data)))
-      (global-set-key (car (car key-bindings)) (cdr (car key-bindings)))
+      (let* ((this (car key-bindings))
+            (key (nth 1 this))
+            (new-def (nth 2 this))
+            old-def)
+       (if (eq (car this) 'global)
+           (progn
+             (setq old-def (global-key-binding key))
+             (global-set-key key new-def))
+         (setq old-def (lookup-key (car this) key))
+         (define-key (car this) key new-def))
+       (setcar (nthcdr 3 this) old-def))
       (setq key-bindings (cdr key-bindings)))))
 
 (defun exit-korean-environment ()
   "Exit Korean language environment."
-  (while exit-korean-environment-data
-    (global-set-key (car (car exit-korean-environment-data))
-                   (cdr (car exit-korean-environment-data)))
-    (setq exit-korean-environment-data
-         (cdr exit-korean-environment-data))))
+  (let ((key-bindings korean-key-bindings))
+    (while key-bindings
+      (let* ((this (car key-bindings))
+            (key (nth 1 this))
+            (new-def (nth 2 this))
+            (old-def (nth 3 this)))
+       (if (eq (car this) 'global)
+           (if (eq (global-key-binding key) new-def)
+               (global-set-key key old-def))
+         (if (eq (lookup-key (car this) key) new-def)
+             (define-key (car this) key old-def))))
+      (setq key-bindings (cdr key-bindings)))))
 
 ;;
 (provide 'korea-util)
 
-;;; korean-util.el ends here
+;;; arch-tag: b17d0981-05da-4577-99f8-1db87fff8b44
+;;; korea-util.el ends here