1;;; korea-util.el --- utilities for Korean
2
3;; Copyright (C) 1997, 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007
4;;   Free Software Foundation, Inc.
5;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
6;;   National Institute of Advanced Industrial Science and Technology (AIST)
7;;   Registration Number H14PRO021
8
9;; Keywords: mule, multilingual, Korean
10
11;; This file is part of GNU Emacs.
12
13;; GNU Emacs is free software; you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation; either version 2, or (at your option)
16;; any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs; see the file COPYING.  If not, write to the
25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26;; Boston, MA 02110-1301, USA.
27
28;;; Commentary:
29
30;;; Code:
31
32;;;###autoload
33(defvar default-korean-keyboard
34  (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") ""))
35      "3"
36    "")
37  "*The kind of Korean keyboard for Korean input method.
38\"\" for 2, \"3\" for 3.")
39
40;; functions useful for Korean text input
41
42(defun toggle-korean-input-method ()
43  "Turn on or off a Korean text input method for the current buffer."
44  (interactive)
45  (if current-input-method
46      (inactivate-input-method)
47    (activate-input-method
48     (concat "korean-hangul" default-korean-keyboard))))
49
50(defun quail-hangul-switch-symbol-ksc (&rest ignore)
51  "Swith to/from Korean symbol package."
52  (interactive "i")
53  (and current-input-method
54       (if (string-equal current-input-method "korean-symbol")
55	   (activate-input-method (concat "korean-hangul"
56					  default-korean-keyboard))
57	 (activate-input-method "korean-symbol"))))
58
59(defun quail-hangul-switch-hanja (&rest ignore)
60  "Swith to/from Korean hanja package."
61  (interactive "i")
62  (and current-input-method
63       (if (string-match "korean-hanja" current-input-method)
64	   (activate-input-method (concat "korean-hangul"
65					  default-korean-keyboard))
66	 (activate-input-method (concat "korean-hanja"
67					default-korean-keyboard)))))
68
69;; The following three commands are set in isearch-mode-map.
70
71(defun isearch-toggle-korean-input-method ()
72  (interactive)
73  (let ((overriding-terminal-local-map nil))
74    (toggle-korean-input-method))
75  (setq isearch-input-method-function input-method-function
76	isearch-input-method-local-p t)
77  (setq input-method-function nil)
78  (isearch-update))
79
80(defun isearch-hangul-switch-symbol-ksc ()
81  (interactive)
82  (let ((overriding-terminal-local-map nil))
83    (quail-hangul-switch-symbol-ksc))
84  (setq isearch-input-method-function input-method-function
85	isearch-input-method-local-p t)
86  (setq input-method-function nil)
87  (isearch-update))
88
89(defun isearch-hangul-switch-hanja ()
90  (interactive)
91  (let ((overriding-terminal-local-map nil))
92    (quail-hangul-switch-hanja))
93  (setq isearch-input-method-function input-method-function
94	isearch-input-method-local-p t)
95  (setq input-method-function nil)
96  (isearch-update))
97
98;; Information for setting and exiting Korean environment.
99(defvar korean-key-bindings
100  `((global [?\S- ] toggle-korean-input-method nil)
101    (global [C-f9] quail-hangul-switch-symbol-ksc nil)
102    (global [f9]  quail-hangul-switch-hanja nil)
103    (,isearch-mode-map [?\S- ] isearch-toggle-korean-input-method nil)
104    (,isearch-mode-map [C-f9] isearch-hangul-switch-symbol-ksc nil)
105    (,isearch-mode-map [f9] isearch-hangul-switch-hanja nil)))
106
107;;;###autoload
108(defun setup-korean-environment-internal ()
109  (let ((key-bindings korean-key-bindings))
110    (while key-bindings
111      (let* ((this (car key-bindings))
112	     (key (nth 1 this))
113	     (new-def (nth 2 this))
114	     old-def)
115	(if (eq (car this) 'global)
116	    (progn
117	      (setq old-def (global-key-binding key))
118	      (global-set-key key new-def))
119	  (setq old-def (lookup-key (car this) key))
120	  (define-key (car this) key new-def))
121	(setcar (nthcdr 3 this) old-def))
122      (setq key-bindings (cdr key-bindings)))))
123
124(defun exit-korean-environment ()
125  "Exit Korean language environment."
126  (let ((key-bindings korean-key-bindings))
127    (while key-bindings
128      (let* ((this (car key-bindings))
129	     (key (nth 1 this))
130	     (new-def (nth 2 this))
131	     (old-def (nth 3 this)))
132	(if (eq (car this) 'global)
133	    (if (eq (global-key-binding key) new-def)
134		(global-set-key key old-def))
135	  (if (eq (lookup-key (car this) key) new-def)
136	      (define-key (car this) key old-def))))
137      (setq key-bindings (cdr key-bindings)))))
138
139;;
140(provide 'korea-util)
141
142;;; arch-tag: b17d0981-05da-4577-99f8-1db87fff8b44
143;;; korea-util.el ends here
144