1 ;;; korea-util.el --- utilities for Korean
3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
5 ;; Licensed to the Free Software Foundation.
7 ;; Keywords: mule, multilingual, Korean
9 ;; This file is part of XEmacs.
11 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; XEmacs is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING. If not, write to the Free
23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
29 (defvar default-korean-keyboard ""
30 "*The kind of Korean keyboard for Korean input method.
31 \"\" for 2, \"3\" for 3.")
33 ;; functions useful for Korean text input
35 (defun toggle-korean-input-method ()
36 "Turn on or off a Korean text input method for the current buffer."
38 (if current-input-method
39 (inactivate-input-method)
40 (activate-input-method
41 (concat "korean-hangul" default-korean-keyboard))))
43 (defun quail-hangul-switch-symbol-ksc (&rest ignore)
44 "Swith to/from Korean symbol package."
46 (and current-input-method
47 (if (string-equal current-input-method "korean-symbol")
48 (activate-input-method (concat "korean-hangul"
49 default-korean-keyboard))
50 (activate-input-method "korean-symbol"))))
52 (defun quail-hangul-switch-hanja (&rest ignore)
53 "Swith to/from Korean hanja package."
55 (and current-input-method
56 (if (string-match "korean-hanja" current-input-method)
57 (activate-input-method (concat "korean-hangul"
58 default-korean-keyboard))
59 (activate-input-method (concat "korean-hanja"
60 default-korean-keyboard)))))
62 ;; The following three commands are set in isearch-mode-map.
64 (defun isearch-toggle-korean-input-method ()
66 (let ((overriding-terminal-local-map nil))
67 (toggle-korean-input-method))
68 (setq isearch-input-method-function input-method-function
69 isearch-input-method-local-p t)
70 (setq input-method-function nil)
73 (defun isearch-hangul-switch-symbol-ksc ()
75 (let ((overriding-terminal-local-map nil))
76 (quail-hangul-switch-symbol-ksc))
77 (setq isearch-input-method-function input-method-function
78 isearch-input-method-local-p t)
79 (setq input-method-function nil)
82 (defun isearch-hangul-switch-hanja ()
84 (let ((overriding-terminal-local-map nil))
85 (quail-hangul-switch-hanja))
86 (setq isearch-input-method-function input-method-function
87 isearch-input-method-local-p t)
88 (setq input-method-function nil)
91 ;; Information for setting and exiting Korean environment.
92 (defvar korean-key-bindings
93 `((global [(shift space)] toggle-korean-input-method nil)
94 (global [(control f9)] quail-hangul-switch-symbol-ksc nil)
95 (global [f9] quail-hangul-switch-hanja nil)
96 (,isearch-mode-map [(shift space)] isearch-toggle-korean-input-method nil)
97 (,isearch-mode-map [(control f9)] isearch-hangul-switch-symbol-ksc nil)
98 (,isearch-mode-map [f9] isearch-hangul-switch-hanja nil)))
101 (defun setup-korean-environment ()
102 "Setup multilingual environment (MULE) for Korean."
104 (set-language-environment "Korean"))
107 (defun setup-korean-environment-internal ()
108 (let ((key-bindings korean-key-bindings))
110 (let* ((this (car key-bindings))
112 (new-def (nth 2 this))
114 (if (eq (car this) 'global)
116 (setq old-def (global-key-binding key))
117 (global-set-key key new-def))
118 (setq old-def (lookup-key (car this) key))
119 (define-key (car this) key new-def))
120 (setcar (nthcdr 3 this) old-def))
121 (setq key-bindings (cdr key-bindings))))
123 ;; EGG specific setup 97.02.05 jhod
124 (when (featurep 'egg)
125 (when (not (featurep 'egg-kor))
128 (setq its:*standard-modes*
129 (cons (its:get-mode-map "hangul") its:*standard-modes*)))
130 (setq-default its:*current-map* (its:get-mode-map "hangul")))
133 (defun exit-korean-environment ()
134 "Exit Korean language environment."
135 (let ((key-bindings korean-key-bindings))
137 (let* ((this (car key-bindings))
139 (new-def (nth 2 this))
140 (old-def (nth 3 this)))
141 (if (eq (car this) 'global)
142 (if (eq (global-key-binding key) new-def)
143 (global-set-key key old-def))
144 (if (eq (lookup-key (car this) key) new-def)
145 (define-key (car this) key old-def))))
146 (setq key-bindings (cdr key-bindings)))))
149 (provide 'korea-util)
151 ;;; korean-util.el ends here