lisp/language/korea-util.el

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