[bpt/emacs.git] / leim / quail / hangul.el

;;; hangul.el --- Korean Hangul input method

;; Author: Jihyun Cho <jihyun.jo@gmail.com>
;; Keywords: multilingual, input method, Korean, Hangul

;; This file is part of GNU Emacs.

;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This file is to implement the following hangul automata:
;; - Hangul 2-Bulsik input method
;; - Hangul 3-Bulsik final input method
;; - Hangul 3-Bulsik 390 input method

;;; Code:

(require 'quail)
(require 'cl)
(require 'hanja-util)

;; Hangul double Jamo table.
;; The format is an alist of JAMO-TYPE vs. DOUBLE-JAMO-TABLE.
;;
;; JAMO-TYPE is a symbol `cho' for Choseong, `jung' for Jungseong, and
;; `jong' for Jongseong.
;;
;; DOUBLE-JAMO-TABLE is an alist of Jamo index vs. the vector of Jamo
;; indies that can be combined with the car part.
;;
;; Jamo index is a relative index in `hangul Compatibility Jamo' area
;; of the Unicode (i.e. 1 for U+3131).

(defconst hangul-djamo-table
  '((cho . ((1 . [1])                   ; Choseong
            (7 . [7])
            (18 . [18])
            (21 . [21])
            (24 . [24])))
    (jung . ((39 . [31 32 51])          ; Jungseong
             (44 . [35 36 51])
             (49 . [51])))
    (jong . ((1 . [1 21])               ; Jongseong
             (4 . [24 30])
             (9 . [1 17 18 21 28 29 30])
             (18 . [18 21])
             (21 . [21])))))

;; Hangul 2-Bulsik keymap.
;; It converts an ASCII code A-Z, a-z, to the corresponding hangul
;; Jamo index.

(defconst hangul2-keymap
  [17 48 26 23 7 9 30 39 33 35 31 51 49 44 32 36 18 1 4 21 37 29 24 28 43 27])

;; Hangul 3-Bulsik final keymap.  3-Bulsik use full keyboard layout.
;; Therefore, we must map all printable ASCII codes (`!' to `~')
;; to Hangul 3-Bulsik codes.
;; Other parts are the same as `hangul2-keymap'.
(defconst hangul3-keymap
  [2 183 24 15 14 8220 120 39 126 8221 43 44 41 46 74 119 30 22 18 78 83
     68 73 85 79 52 110 44 62 46 33 10 7 63 27 12 5 11 69 48 55 49 50 51
     34 45 56 57 29 16 6 13 54 3 28 20 53 26 40 58 60 61 59 42 23 79 71
     86 72 66 84 96 109 115 93 116 122 113 118 121 21 67 4 70 99 74 9 1
     101 17 37 92 47 8251])

;; Hangul 3-Bulsik 390 keymap.
;; The role is the same as `hangul3-keymap'.
(defconst hangul390-keymap
  [24 34 35 36 37 38 120 40 41 42 43 44 45 46 73 119 30 22 18 77 82 67 72
      84 78 58 110 50 61 51 63 64 7 33 11 10 27 2 47 39 56 52 53 54 49 48
      57 62 29 68 6 59 55 16 28 20 60 26 91 92 93 94 95 96 23 78 70 85 71
      65 83 90 109 115 87 116 122 113 118 121 21 66 4 69 99 73 9 1 101 17
      123 124 125 126])

(defvar hangul-im-keymap
  (let ((map (make-sparse-keymap)))
    (define-key map "\d" 'hangul-delete-backward-char)
    (define-key map [f9] 'hangul-to-hanja-conversion)
    map)
  "Keymap for Hangul method.  It is used by all Hangul input method.")

;; Current input character buffer. Store separated hangul character.
;; The first and second are Choseong position.
;; The third and forth are Jungseong position.
;; The fifth and sixth are Jongseong position.
;; The second, forth and sixth are double Jamo position.
(defvar hangul-queue
  (make-vector 6 0))

(defsubst notzerop (number)
  (not (zerop number)))

(defsubst alphabetp (char)
  (or (and (>= char ?A) (<= char ?Z))
      (and (>= char ?a) (<= char ?z))))

(defun hangul-character (cho jung jong)
  "Convert CHO, JUNG, JONG to the precomposed `Hangul Syllables' character.
CHO, JUNG, JONG are relative indices in `Hangul Compatibility Jamo' of unicode.
Return a zero-length string if the conversion fails."
  (or
   (decode-char
    'ucs
    (if (and (/= cho 0) (/= jung 0))
        (+ #xac00
           (* 588
              (- cho
                 (cond ((< cho 3) 1)
                       ((< cho 5) 2)
                       ((< cho 10) 4)
                       ((< cho 20) 11)
                       (t 12))))
           (* 28 (- jung 31))
           (- jong
              (cond ((< jong 8) 0)
                    ((< jong 19) 1)
                    ((< jong 25) 2)
                    (t 3))))
      (+ #x3130
	 (cond ((/= cho 0) cho)
	       ((/= jung 0) jung)
	       ((/= jong 0) jong)))))
   ""))

(defun hangul-insert-character (&rest queues)
  "Insert characters generated from QUEUEs.
Each QUEUE has the same form as `hangul-queue'.
Setup `quail-overlay' to the last character."
  (if (and mark-active transient-mark-mode)
      (progn
        (delete-region (region-beginning) (region-end))
        (deactivate-mark)))
  (quail-delete-region)
  (let ((first (car queues)))
    (insert
     (hangul-character
      (+ (aref first 0) (hangul-djamo 'cho (aref first 0) (aref first 1)))
      (+ (aref first 2) (hangul-djamo 'jung (aref first 2) (aref first 3)))
      (+ (aref first 4) (hangul-djamo 'jong (aref first 4) (aref first 5))))))
  (move-overlay quail-overlay (overlay-start quail-overlay) (point))
  (dolist (queue (cdr queues))
    (insert
     (hangul-character
      (+ (aref queue 0) (hangul-djamo 'cho (aref queue 0) (aref queue 1)))
      (+ (aref queue 2) (hangul-djamo 'jung (aref queue 2) (aref queue 3)))
      (+ (aref queue 4) (hangul-djamo 'jong (aref queue 4) (aref queue 5)))))
    (move-overlay quail-overlay (1+ (overlay-start quail-overlay)) (point))))

(defun hangul-djamo (jamo char1 char2)
  "Return the dobule Jamo index calculated from the arguments.
JAMO is a type of Hangul Jamo; `cho', `jung', or `jong'.
CHAR1 and CHAR2 are Hangul Jamo indices.
Return nil if CHAR1 and CHAR2 can not combined."
  (let* ((jamo (cdr (assoc jamo hangul-djamo-table)))
         (char1 (cdr (assoc char1 jamo))))
    (if char1
        (let ((i (length char1)))
          (or (catch 'found
                (while (> i 0)
                  (if (= char2 (aref char1 (1- i)))
                      (throw 'found i))
                  (setf i (1- i))))
              0))
      0)))

(defsubst hangul2-input-method-jaum (char)
  "Store Hangul Jamo indice CHAR in `hangul-queue'.
It is a Hangul 2-Bulsik Jaum.
This function processes a Hangul 2-Bulsik Jaum.
The Hangul 2-Bulsik is composed of a Jaum and a Moum.
The Jaum can be located in a Choseong position and a Jongseong position.
Unless the function inserts CHAR to `hangul-queue',
commit current `hangul-queue' and then set a new `hangul-queue',
and insert CHAR to new `hangul-queue'."
  (if (cond ((zerop (aref hangul-queue 0))
             (aset hangul-queue 0 char))
            ((and (zerop (aref hangul-queue 1))
                  (zerop (aref hangul-queue 2))
                  (notzerop (hangul-djamo 'cho (aref hangul-queue 0) char)))
             (aset hangul-queue 1 char))
            ((and (zerop (aref hangul-queue 4))
                  (notzerop (aref hangul-queue 2))
                  (/= char 8)
                  (/= char 19)
                  (/= char 25)
                  (numberp
                   (hangul-character
                    (+ (aref hangul-queue 0)
                       (hangul-djamo
                        'cho
                        (aref hangul-queue 0)
                        (aref hangul-queue 1)))
                    (+ (aref hangul-queue 2)
                       (hangul-djamo
                        'jung
                        (aref hangul-queue 2)
                        (aref hangul-queue 3)))
                    char)))
             (aset hangul-queue 4 char))
            ((and (zerop (aref hangul-queue 5))
                  (notzerop (hangul-djamo 'jong (aref hangul-queue 4) char))
                  (numberp
                   (hangul-character
                    (+ (aref hangul-queue 0)
                       (hangul-djamo
                        'cho
                        (aref hangul-queue 0)
                        (aref hangul-queue 1)))
                    (+ (aref hangul-queue 2)
                       (hangul-djamo
                        'jung
                        (aref hangul-queue 2)
                        (aref hangul-queue 3)))
                    (+ (aref hangul-queue 4)
                       (hangul-djamo
                        'jong
                        (aref hangul-queue 4)
                        char)))))
             (aset hangul-queue 5 char)))
      (hangul-insert-character hangul-queue)
    (hangul-insert-character hangul-queue
			     (setq hangul-queue (vector char 0 0 0 0 0)))))

(defsubst hangul2-input-method-moum (char)
  "Store Hangul Jamo indice CHAR in `hangul-queue'.
It is a Hangul 2-Bulsik Moum.
This function process a Hangul 2-Bulsik Moum.
The Moum can be located in a Jungseong position.
Other parts are the same as a `hangul2-input-method-jaum'."
  (if (cond ((zerop (aref hangul-queue 2))
             (aset hangul-queue 2 char))
            ((and (zerop (aref hangul-queue 3))
                  (zerop (aref hangul-queue 4))
                  (notzerop (hangul-djamo 'jung (aref hangul-queue 2) char)))
             (aset hangul-queue 3 char)))
      (hangul-insert-character hangul-queue)
    (let ((next-char (vector 0 0 char 0 0 0)))
      (cond ((notzerop (aref hangul-queue 5))
	     (aset next-char 0 (aref hangul-queue 5))
	     (aset hangul-queue 5 0))
	    ((notzerop (aref hangul-queue 4))
	     (aset next-char 0 (aref hangul-queue 4))
	     (aset hangul-queue 4 0)))
      (hangul-insert-character hangul-queue
			       (setq hangul-queue next-char)))))

(defsubst hangul3-input-method-cho (char)
  "Store Hangul Jamo indice CHAR in `hangul-queue'.
It is a Hangul 3-Bulsik Choseong.
This function process a Hangul 3-Bulsik Choseong.
The Hangul 3-Bulsik is composed of a Choseong, a Jungseong and a Jongseong.
The Choseong can be located in a Choseong position.
Other parts are the same as a `hangul2-input-method-jaum'."
  (if (cond ((and (zerop (aref hangul-queue 0))
                  (zerop (aref hangul-queue 4)))
             (aset hangul-queue 0 char))
            ((and (zerop (aref hangul-queue 1))
                  (zerop (aref hangul-queue 2))
                  (notzerop (hangul-djamo 'cho (aref hangul-queue 0) char)))
             (aset hangul-queue 1 char)))
      (hangul-insert-character hangul-queue)
    (hangul-insert-character hangul-queue
			     (setq hangul-queue (vector char 0 0 0 0 0)))))

(defsubst hangul3-input-method-jung (char)
  "Store Hangul Jamo indice CHAR in `hangul-queue'.
It is a Hangul 3-Bulsik Jungseong.
This function process a Hangul 3-Bulsik Jungseong.
The Jungseong can be located in a Jungseong position.
Other parts are the same as a `hangul3-input-method-cho'."
  (if (cond ((and (zerop (aref hangul-queue 2))
                  (zerop (aref hangul-queue 4)))
             (aset hangul-queue 2 char))
            ((and (zerop (aref hangul-queue 3))
                  (notzerop (hangul-djamo 'jung (aref hangul-queue 2) char)))
             (aset hangul-queue 3 char)))
      (hangul-insert-character hangul-queue)
    (hangul-insert-character hangul-queue
			     (setq hangul-queue (vector 0 0 char 0 0 0)))))

(defsubst hangul3-input-method-jong (char)
  "Store Hangul Jamo indice CHAR in `hangul-queue'.
It is a Hangul 3-Bulsik Jongseong.
This function process a Hangul 3-Bulsik Jongseong.
The Jongseong can be located in a Jongseong position.
Other parts are the same as a `hangul3-input-method-cho'."
  (if (cond ((and (zerop (aref hangul-queue 4))
                  (notzerop (aref hangul-queue 0))
                  (notzerop (aref hangul-queue 2))
                  (numberp
                   (hangul-character
                    (+ (aref hangul-queue 0)
                       (hangul-djamo
                        'cho
                        (aref hangul-queue 0)
                        (aref hangul-queue 1)))
                    (+ (aref hangul-queue 2)
                       (hangul-djamo
                        'jung
                        (aref hangul-queue 2)
                        (aref hangul-queue 3)))
                    char)))
             (aset hangul-queue 4 char))
            ((and (zerop (aref hangul-queue 5))
                  (notzerop (hangul-djamo 'jong (aref hangul-queue 4) char))
                  (numberp
                   (hangul-character
                    (+ (aref hangul-queue 0)
                       (hangul-djamo
                        'cho
                        (aref hangul-queue 0)
                        (aref hangul-queue 1)))
                    (+ (aref hangul-queue 2)
                       (hangul-djamo
                        'jung
                        (aref hangul-queue 2)
                        (aref hangul-queue 3)))
                    (+ (aref hangul-queue 4)
                       (hangul-djamo
                        'jong
                        (aref hangul-queue 4)
                        char)))))
             (aset hangul-queue 5 char)))
      (hangul-insert-character hangul-queue)
    (if (zerop (apply '+ (append hangul-queue nil)))
	(hangul-insert-character (setq hangul-queue (vector 0 0 0 0 char 0)))
      (hangul-insert-character hangul-queue
			       (setq hangul-queue (vector 0 0 0 0 char 0))))))

(defun hangul-delete-backward-char ()
  "Delete the previous hangul character by Jaso units."
  (interactive)
  (let ((i 5))
    (while (and (> i 0) (zerop (aref hangul-queue i)))
      (setq i (1- i)))
    (aset hangul-queue i 0))
  (if (notzerop (apply '+ (append hangul-queue nil)))
      (hangul-insert-character hangul-queue)
    (delete-backward-char 1)))

(defun hangul-to-hanja-conversion ()
  "Convert the previous hangul character to the corresponding hanja character."
  (interactive)
  (let ((echo-keystrokes 0)
        delete-func
        hanja-character)
    (setq hanja-character (hangul-to-hanja-char (preceding-char)))
    (when hanja-character
      (delete-backward-char 1)
      (insert hanja-character)
      (setq hangul-queue (make-vector 6 0))
      (move-overlay quail-overlay (point) (point)))))

;; Support function for `hangul2-input-method'.  Actually, this
;; function handles the Hangul 2-Bulsik.  KEY is an entered key code
;; used for looking up `hangul2-keymap'."
(defun hangul2-input-method-internal (key)
  (let ((char (+ (aref hangul2-keymap (1- (% key 32)))
                 (cond ((or (= key ?O) (= key ?P)) 2)
                       ((or (= key ?E) (= key ?Q) (= key ?R)
                            (= key ?T) (= key ?W)) 1)
                       (t 0)))))
    (if (< char 31)
        (hangul2-input-method-jaum char)
      (hangul2-input-method-moum char))))

(defun hangul2-input-method (key)
  "2-Bulsik input method."
  (if (or buffer-read-only (not (alphabetp key)))
      (list key)
    (quail-setup-overlays nil)
    (let ((input-method-function nil)
	  (echo-keystrokes 0)
	  (help-char nil))
      (setq hangul-queue (make-vector 6 0))
      (hangul2-input-method-internal key)
      (unwind-protect
	  (catch 'exit-input-loop
	    (while t
	      (let* ((seq (read-key-sequence nil))
		     (cmd (lookup-key hangul-im-keymap seq))
		     key)
		(cond ((and (stringp seq)
			    (= 1 (length seq))
			    (setq key (aref seq 0))
			    (alphabetp key))
		       (hangul2-input-method-internal key))
		      ((commandp cmd)
		       (call-interactively cmd))
		      (t
		       (setq unread-command-events (listify-key-sequence seq))
		       (throw 'exit-input-loop nil))))))
	(quail-delete-overlays)))))

;; Support function for `hangul3-input-method'.  Actually, this
;; function handles the Hangul 3-Bulsik final.  KEY is an entered key
;; code used for looking up `hangul3-keymap'."
(defun hangul3-input-method-internal (key)
  (let ((char (aref hangul3-keymap (- key 33))))
    (cond ((and (> char 92) (< char 123))
           (hangul3-input-method-cho (- char 92)))
          ((and (> char 65) (< char 87))
           (hangul3-input-method-jung (- char 35)))
          ((< char 31)
           (hangul3-input-method-jong char))
          (t
           (setq hangul-queue (make-vector 6 0))
           (insert (decode-char 'ucs char))
           (move-overlay quail-overlay (point) (point))))))

(defun hangul3-input-method (key)
  "3-Bulsik final input method."
  (if (or buffer-read-only (< key 33) (>= key 127))
      (list key)
    (quail-setup-overlays nil)
    (let ((input-method-function nil)
	  (echo-keystrokes 0)
	  (help-char nil))
      (setq hangul-queue (make-vector 6 0))
      (hangul3-input-method-internal key)
      (unwind-protect
	  (catch 'exit-input-loop
	    (while t
	      (let* ((seq (read-key-sequence nil))
		     (cmd (lookup-key hangul-im-keymap seq))
		     key)
		(cond ((and (stringp seq)
			    (= 1 (length seq))
			    (setq key (aref seq 0))
			    (and (>= key 33) (< key 127)))
		       (hangul3-input-method-internal key))
		      ((commandp cmd)
		       (call-interactively cmd))
		      (t
		       (setq unread-command-events (listify-key-sequence seq))
		       (throw 'exit-input-loop nil))))))
	(quail-delete-overlays)))))

;; Support function for `hangul390-input-method'.  Actually, this
;; function handles the Hangul 3-Bulsik 390.  KEY is an entered key
;; code used for looking up `hangul390-keymap'."
(defun hangul390-input-method-internal (key)
  (let ((char (aref hangul390-keymap (- key 33))))
    (cond ((or (and (> char 86) (< char 91))
               (and (> char 96) (< char 123)))
           (hangul3-input-method-cho (- char (if (< char 97) 86 92))))
          ((and (> char 64) (< char 86))
           (hangul3-input-method-jung (- char 34)))
          ((< char 31)
           (hangul3-input-method-jong char))
          (t
           (setq hangul-queue (make-vector 6 0))
           (insert (decode-char 'ucs char))
           (move-overlay quail-overlay (point) (point))))))

(defun hangul390-input-method (key)
  "3-Bulsik 390 input method."
  (if (or buffer-read-only (< key 33) (>= key 127))
      (list key)
    (quail-setup-overlays nil)
    (let ((input-method-function nil)
	  (echo-keystrokes 0)
	  (help-char nil))
      (setq hangul-queue (make-vector 6 0))
      (hangul390-input-method-internal key)
      (unwind-protect
	  (catch 'exit-input-loop
	    (while t
	      (let* ((seq (read-key-sequence nil))
		     (cmd (lookup-key hangul-im-keymap seq))
		     key)
		(cond ((and (stringp seq)
			    (= 1 (length seq))
			    (setq key (aref seq 0))
			    (and (>= key 33) (< key 127)))
		       (hangul390-input-method-internal key))
		      ((commandp cmd)
		       (call-interactively cmd))
		      (t
		       (setq unread-command-events (listify-key-sequence seq))
		       (throw 'exit-input-loop nil))))))
	(quail-delete-overlays)))))

;; Text shown by describe-input-method.  Set to a proper text by
;; hangul-input-method-activate.
(defvar hangul-input-method-help-text nil)
(make-variable-buffer-local 'hangul-input-method-help-text)

(defun hangul-input-method-activate (input-method func help-text &rest args)
  "Activate Hangul input method INPUT-METHOD.
FUNC is a function to handle input key.
HELP-TEXT is a text set in `hangul-input-method-help-text'."
  (setq inactivate-current-input-method-function 'hangul-input-method-inactivate
	describe-current-input-method-function 'hangul-input-method-help
	hangul-input-method-help-text help-text)
  (quail-delete-overlays)
  (if (eq (selected-window) (minibuffer-window))
      (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))
  (set (make-local-variable 'input-method-function) func))

(defun hangul-input-method-inactivate ()
  "Inactivate the current Hangul input method."
  (interactive)
  (unwind-protect
      (progn
        (quail-hide-guidance)
        (quail-delete-overlays)
        (setq describe-current-input-method-function nil))
    (kill-local-variable 'input-method-function)))

(defun hangul-input-method-help ()
  "Describe the current Hangul input method."
  (interactive)
  (with-output-to-temp-buffer "*Help*"
    (princ hangul-input-method-help-text)))

(provide 'hangul)

;; arch-tag: 26bc93fc-64ee-4fb1-b26d-22220d132dbe
;;; hangul.el ends here
Commit	Line	Data
b3ccb19c	1	;;; hangul.el --- Korean Hangul input method
24b31c88	2
b3ccb19c	3	;; Author: Jihyun Cho <jihyun.jo@gmail.com>
24b31c88 KH	4	;; Keywords: multilingual, input method, Korean, Hangul
	5
	6	;; This file is part of GNU Emacs.
	7
3d544458	8	;; GNU Emacs is free software: you can redistribute it and/or modify
24b31c88	9	;; it under the terms of the GNU General Public License as published by
3d544458 GM	10	;; the Free Software Foundation, either version 3 of the License, or
3d544458 GM	11	;; (at your option) any later version.
24b31c88 KH	12
	13	;; GNU Emacs is distributed in the hope that it will be useful,
	14	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	15	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	16	;; GNU General Public License for more details.
	17
	18	;; You should have received a copy of the GNU General Public License
3d544458	19	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24b31c88	20
be567141 PJ	21	;;; Commentary:
be567141 PJ	22
b3ccb19c KH	23	;; This file is to implement the following hangul automata:
	24	;; - Hangul 2-Bulsik input method
	25	;; - Hangul 3-Bulsik final input method
	26	;; - Hangul 3-Bulsik 390 input method
a155c353	27
24b31c88 KH	28	;;; Code:
	29
	30	(require 'quail)
b3ccb19c KH	31	(require 'cl)
	32	(require 'hanja-util)
	33
3436ab42	34	;; Hangul double Jamo table.
ebba3e08 KH	35	;; The format is an alist of JAMO-TYPE vs. DOUBLE-JAMO-TABLE.
	36	;;
	37	;; JAMO-TYPE is a symbol `cho' for Choseong, `jung' for Jungseong, and
	38	;; `jong' for Jongseong.
	39	;;
3436ab42	40	;; DOUBLE-JAMO-TABLE is an alist of Jamo index vs. the vector of Jamo
ebba3e08 KH	41	;; indies that can be combined with the car part.
	42	;;
	43	;; Jamo index is a relative index in `hangul Compatibility Jamo' area
	44	;; of the Unicode (i.e. 1 for U+3131).
	45
b3ccb19c	46	(defconst hangul-djamo-table
ebba3e08	47	'((cho . ((1 . [1]) ; Choseong
b3ccb19c KH	48	(7 . [7])
	49	(18 . [18])
	50	(21 . [21])
	51	(24 . [24])))
ebba3e08	52	(jung . ((39 . [31 32 51]) ; Jungseong
b3ccb19c KH	53	(44 . [35 36 51])
b3ccb19c KH	54	(49 . [51])))
ebba3e08	55	(jong . ((1 . [1 21]) ; Jongseong
b3ccb19c KH	56	(4 . [24 30])
	57	(9 . [1 17 18 21 28 29 30])
	58	(18 . [18 21])
	59	(21 . [21])))))
	60
	61	;; Hangul 2-Bulsik keymap.
ebba3e08	62	;; It converts an ASCII code A-Z, a-z, to the corresponding hangul
3436ab42	63	;; Jamo index.
ebba3e08	64
b3ccb19c KH	65	(defconst hangul2-keymap
	66	[17 48 26 23 7 9 30 39 33 35 31 51 49 44 32 36 18 1 4 21 37 29 24 28 43 27])
	67
	68	;; Hangul 3-Bulsik final keymap. 3-Bulsik use full keyboard layout.
ebba3e08	69	;; Therefore, we must map all printable ASCII codes (`!' to `~')
b3ccb19c	70	;; to Hangul 3-Bulsik codes.
ebba3e08	71	;; Other parts are the same as `hangul2-keymap'.
b3ccb19c KH	72	(defconst hangul3-keymap
	73	[2 183 24 15 14 8220 120 39 126 8221 43 44 41 46 74 119 30 22 18 78 83
	74	68 73 85 79 52 110 44 62 46 33 10 7 63 27 12 5 11 69 48 55 49 50 51
	75	34 45 56 57 29 16 6 13 54 3 28 20 53 26 40 58 60 61 59 42 23 79 71
	76	86 72 66 84 96 109 115 93 116 122 113 118 121 21 67 4 70 99 74 9 1
	77	101 17 37 92 47 8251])
	78
	79	;; Hangul 3-Bulsik 390 keymap.
ebba3e08	80	;; The role is the same as `hangul3-keymap'.
b3ccb19c KH	81	(defconst hangul390-keymap
	82	[24 34 35 36 37 38 120 40 41 42 43 44 45 46 73 119 30 22 18 77 82 67 72
	83	84 78 58 110 50 61 51 63 64 7 33 11 10 27 2 47 39 56 52 53 54 49 48
	84	57 62 29 68 6 59 55 16 28 20 60 26 91 92 93 94 95 96 23 78 70 85 71
	85	65 83 90 109 115 87 116 122 113 118 121 21 66 4 69 99 73 9 1 101 17
	86	123 124 125 126])
	87
	88	(defvar hangul-im-keymap
	89	(let ((map (make-sparse-keymap)))
	90	(define-key map "\d" 'hangul-delete-backward-char)
	91	(define-key map [f9] 'hangul-to-hanja-conversion)
	92	map)
ebba3e08	93	"Keymap for Hangul method. It is used by all Hangul input method.")
b3ccb19c KH	94
b3ccb19c KH	95	;; Current input character buffer. Store separated hangul character.
3436ab42 KH	96	;; The first and second are Choseong position.
	97	;; The third and forth are Jungseong position.
	98	;; The fifth and sixth are Jongseong position.
	99	;; The second, forth and sixth are double Jamo position.
b3ccb19c KH	100	(defvar hangul-queue
	101	(make-vector 6 0))
	102
	103	(defsubst notzerop (number)
	104	(not (zerop number)))
	105
	106	(defsubst alphabetp (char)
	107	(or (and (>= char ?A) (<= char ?Z))
	108	(and (>= char ?a) (<= char ?z))))
	109
	110	(defun hangul-character (cho jung jong)
ebba3e08 KH	111	"Convert CHO, JUNG, JONG to the precomposed `Hangul Syllables' character.
	112	CHO, JUNG, JONG are relative indices in `Hangul Compatibility Jamo' of unicode.
	113	Return a zero-length string if the conversion fails."
b3ccb19c KH	114	(or
	115	(decode-char
	116	'ucs
	117	(if (and (/= cho 0) (/= jung 0))
	118	(+ #xac00
	119	(* 588
	120	(- cho
	121	(cond ((< cho 3) 1)
	122	((< cho 5) 2)
	123	((< cho 10) 4)
	124	((< cho 20) 11)
	125	(t 12))))
	126	(* 28 (- jung 31))
	127	(- jong
	128	(cond ((< jong 8) 0)
	129	((< jong 19) 1)
	130	((< jong 25) 2)
	131	(t 3))))
3436ab42 KH	132	(+ #x3130
	133	(cond ((/= cho 0) cho)
	134	((/= jung 0) jung)
	135	((/= jong 0) jong)))))
b3ccb19c KH	136	""))
	137
	138	(defun hangul-insert-character (&rest queues)
ebba3e08 KH	139	"Insert characters generated from QUEUEs.
	140	Each QUEUE has the same form as `hangul-queue'.
	141	Setup `quail-overlay' to the last character."
b3ccb19c KH	142	(if (and mark-active transient-mark-mode)
	143	(progn
	144	(delete-region (region-beginning) (region-end))
	145	(deactivate-mark)))
	146	(quail-delete-region)
	147	(let ((first (car queues)))
	148	(insert
	149	(hangul-character
	150	(+ (aref first 0) (hangul-djamo 'cho (aref first 0) (aref first 1)))
	151	(+ (aref first 2) (hangul-djamo 'jung (aref first 2) (aref first 3)))
	152	(+ (aref first 4) (hangul-djamo 'jong (aref first 4) (aref first 5))))))
	153	(move-overlay quail-overlay (overlay-start quail-overlay) (point))
	154	(dolist (queue (cdr queues))
	155	(insert
	156	(hangul-character
	157	(+ (aref queue 0) (hangul-djamo 'cho (aref queue 0) (aref queue 1)))
	158	(+ (aref queue 2) (hangul-djamo 'jung (aref queue 2) (aref queue 3)))
	159	(+ (aref queue 4) (hangul-djamo 'jong (aref queue 4) (aref queue 5)))))
	160	(move-overlay quail-overlay (1+ (overlay-start quail-overlay)) (point))))
	161
	162	(defun hangul-djamo (jamo char1 char2)
3436ab42 KH	163	"Return the dobule Jamo index calculated from the arguments.
3436ab42 KH	164	JAMO is a type of Hangul Jamo; `cho', `jung', or `jong'.
53a8f9db	165	CHAR1 and CHAR2 are Hangul Jamo indices.
ebba3e08	166	Return nil if CHAR1 and CHAR2 can not combined."
b3ccb19c KH	167	(let* ((jamo (cdr (assoc jamo hangul-djamo-table)))
	168	(char1 (cdr (assoc char1 jamo))))
	169	(if char1
	170	(let ((i (length char1)))
	171	(or (catch 'found
	172	(while (> i 0)
	173	(if (= char2 (aref char1 (1- i)))
	174	(throw 'found i))
	175	(setf i (1- i))))
	176	0))
3436ab42	177	0)))
b3ccb19c	178
b3ccb19c	179	(defsubst hangul2-input-method-jaum (char)
3436ab42 KH	180	"Store Hangul Jamo indice CHAR in `hangul-queue'.
	181	It is a Hangul 2-Bulsik Jaum.
	182	This function processes a Hangul 2-Bulsik Jaum.
	183	The Hangul 2-Bulsik is composed of a Jaum and a Moum.
	184	The Jaum can be located in a Choseong position and a Jongseong position.
	185	Unless the function inserts CHAR to `hangul-queue',
	186	commit current `hangul-queue' and then set a new `hangul-queue',
	187	and insert CHAR to new `hangul-queue'."
b3ccb19c KH	188	(if (cond ((zerop (aref hangul-queue 0))
	189	(aset hangul-queue 0 char))
	190	((and (zerop (aref hangul-queue 1))
	191	(zerop (aref hangul-queue 2))
	192	(notzerop (hangul-djamo 'cho (aref hangul-queue 0) char)))
	193	(aset hangul-queue 1 char))
	194	((and (zerop (aref hangul-queue 4))
	195	(notzerop (aref hangul-queue 2))
	196	(/= char 8)
	197	(/= char 19)
	198	(/= char 25)
	199	(numberp
	200	(hangul-character
	201	(+ (aref hangul-queue 0)
	202	(hangul-djamo
	203	'cho
	204	(aref hangul-queue 0)
	205	(aref hangul-queue 1)))
	206	(+ (aref hangul-queue 2)
	207	(hangul-djamo
	208	'jung
	209	(aref hangul-queue 2)
	210	(aref hangul-queue 3)))
	211	char)))
	212	(aset hangul-queue 4 char))
	213	((and (zerop (aref hangul-queue 5))
	214	(notzerop (hangul-djamo 'jong (aref hangul-queue 4) char))
	215	(numberp
	216	(hangul-character
	217	(+ (aref hangul-queue 0)
	218	(hangul-djamo
	219	'cho
	220	(aref hangul-queue 0)
	221	(aref hangul-queue 1)))
	222	(+ (aref hangul-queue 2)
	223	(hangul-djamo
	224	'jung
	225	(aref hangul-queue 2)
	226	(aref hangul-queue 3)))
	227	(+ (aref hangul-queue 4)
	228	(hangul-djamo
	229	'jong
	230	(aref hangul-queue 4)
	231	char)))))
	232	(aset hangul-queue 5 char)))
	233	(hangul-insert-character hangul-queue)
3436ab42 KH	234	(hangul-insert-character hangul-queue
3436ab42 KH	235	(setq hangul-queue (vector char 0 0 0 0 0)))))
b3ccb19c KH	236
b3ccb19c KH	237	(defsubst hangul2-input-method-moum (char)
3436ab42 KH	238	"Store Hangul Jamo indice CHAR in `hangul-queue'.
	239	It is a Hangul 2-Bulsik Moum.
	240	This function process a Hangul 2-Bulsik Moum.
	241	The Moum can be located in a Jungseong position.
ebba3e08	242	Other parts are the same as a `hangul2-input-method-jaum'."
b3ccb19c KH	243	(if (cond ((zerop (aref hangul-queue 2))
	244	(aset hangul-queue 2 char))
	245	((and (zerop (aref hangul-queue 3))
	246	(zerop (aref hangul-queue 4))
	247	(notzerop (hangul-djamo 'jung (aref hangul-queue 2) char)))
	248	(aset hangul-queue 3 char)))
	249	(hangul-insert-character hangul-queue)
3436ab42 KH	250	(let ((next-char (vector 0 0 char 0 0 0)))
	251	(cond ((notzerop (aref hangul-queue 5))
	252	(aset next-char 0 (aref hangul-queue 5))
	253	(aset hangul-queue 5 0))
	254	((notzerop (aref hangul-queue 4))
	255	(aset next-char 0 (aref hangul-queue 4))
	256	(aset hangul-queue 4 0)))
	257	(hangul-insert-character hangul-queue
	258	(setq hangul-queue next-char)))))
b3ccb19c KH	259
b3ccb19c KH	260	(defsubst hangul3-input-method-cho (char)
3436ab42 KH	261	"Store Hangul Jamo indice CHAR in `hangul-queue'.
	262	It is a Hangul 3-Bulsik Choseong.
	263	This function process a Hangul 3-Bulsik Choseong.
	264	The Hangul 3-Bulsik is composed of a Choseong, a Jungseong and a Jongseong.
	265	The Choseong can be located in a Choseong position.
ebba3e08	266	Other parts are the same as a `hangul2-input-method-jaum'."
b3ccb19c KH	267	(if (cond ((and (zerop (aref hangul-queue 0))
	268	(zerop (aref hangul-queue 4)))
	269	(aset hangul-queue 0 char))
	270	((and (zerop (aref hangul-queue 1))
	271	(zerop (aref hangul-queue 2))
	272	(notzerop (hangul-djamo 'cho (aref hangul-queue 0) char)))
	273	(aset hangul-queue 1 char)))
	274	(hangul-insert-character hangul-queue)
3436ab42 KH	275	(hangul-insert-character hangul-queue
3436ab42 KH	276	(setq hangul-queue (vector char 0 0 0 0 0)))))
b3ccb19c KH	277
b3ccb19c KH	278	(defsubst hangul3-input-method-jung (char)
3436ab42 KH	279	"Store Hangul Jamo indice CHAR in `hangul-queue'.
	280	It is a Hangul 3-Bulsik Jungseong.
	281	This function process a Hangul 3-Bulsik Jungseong.
	282	The Jungseong can be located in a Jungseong position.
ebba3e08	283	Other parts are the same as a `hangul3-input-method-cho'."
b3ccb19c KH	284	(if (cond ((and (zerop (aref hangul-queue 2))
	285	(zerop (aref hangul-queue 4)))
	286	(aset hangul-queue 2 char))
	287	((and (zerop (aref hangul-queue 3))
	288	(notzerop (hangul-djamo 'jung (aref hangul-queue 2) char)))
	289	(aset hangul-queue 3 char)))
	290	(hangul-insert-character hangul-queue)
3436ab42 KH	291	(hangul-insert-character hangul-queue
3436ab42 KH	292	(setq hangul-queue (vector 0 0 char 0 0 0)))))
b3ccb19c KH	293
b3ccb19c KH	294	(defsubst hangul3-input-method-jong (char)
3436ab42 KH	295	"Store Hangul Jamo indice CHAR in `hangul-queue'.
	296	It is a Hangul 3-Bulsik Jongseong.
	297	This function process a Hangul 3-Bulsik Jongseong.
	298	The Jongseong can be located in a Jongseong position.
ebba3e08	299	Other parts are the same as a `hangul3-input-method-cho'."
b3ccb19c KH	300	(if (cond ((and (zerop (aref hangul-queue 4))
	301	(notzerop (aref hangul-queue 0))
	302	(notzerop (aref hangul-queue 2))
	303	(numberp
	304	(hangul-character
	305	(+ (aref hangul-queue 0)
	306	(hangul-djamo
	307	'cho
	308	(aref hangul-queue 0)
	309	(aref hangul-queue 1)))
	310	(+ (aref hangul-queue 2)
	311	(hangul-djamo
	312	'jung
	313	(aref hangul-queue 2)
	314	(aref hangul-queue 3)))
	315	char)))
	316	(aset hangul-queue 4 char))
	317	((and (zerop (aref hangul-queue 5))
	318	(notzerop (hangul-djamo 'jong (aref hangul-queue 4) char))
	319	(numberp
	320	(hangul-character
	321	(+ (aref hangul-queue 0)
	322	(hangul-djamo
	323	'cho
	324	(aref hangul-queue 0)
	325	(aref hangul-queue 1)))
	326	(+ (aref hangul-queue 2)
	327	(hangul-djamo
	328	'jung
	329	(aref hangul-queue 2)
	330	(aref hangul-queue 3)))
	331	(+ (aref hangul-queue 4)
	332	(hangul-djamo
	333	'jong
	334	(aref hangul-queue 4)
	335	char)))))
92135d25	336	(aset hangul-queue 5 char)))
b3ccb19c	337	(hangul-insert-character hangul-queue)
3436ab42 KH	338	(if (zerop (apply '+ (append hangul-queue nil)))
	339	(hangul-insert-character (setq hangul-queue (vector 0 0 0 0 char 0)))
	340	(hangul-insert-character hangul-queue
	341	(setq hangul-queue (vector 0 0 0 0 char 0))))))
b3ccb19c KH	342
b3ccb19c KH	343	(defun hangul-delete-backward-char ()
3436ab42	344	"Delete the previous hangul character by Jaso units."
b3ccb19c KH	345	(interactive)
	346	(let ((i 5))
	347	(while (and (> i 0) (zerop (aref hangul-queue i)))
	348	(setq i (1- i)))
	349	(aset hangul-queue i 0))
	350	(if (notzerop (apply '+ (append hangul-queue nil)))
	351	(hangul-insert-character hangul-queue)
3436ab42	352	(delete-backward-char 1)))
24b31c88	353
b3ccb19c	354	(defun hangul-to-hanja-conversion ()
ebba3e08	355	"Convert the previous hangul character to the corresponding hanja character."
b3ccb19c KH	356	(interactive)
	357	(let ((echo-keystrokes 0)
	358	delete-func
	359	hanja-character)
	360	(setq hanja-character (hangul-to-hanja-char (preceding-char)))
	361	(when hanja-character
	362	(delete-backward-char 1)
	363	(insert hanja-character)
	364	(setq hangul-queue (make-vector 6 0))
	365	(move-overlay quail-overlay (point) (point)))))
24b31c88	366
ebba3e08 KH	367	;; Support function for `hangul2-input-method'. Actually, this
	368	;; function handles the Hangul 2-Bulsik. KEY is an entered key code
	369	;; used for looking up `hangul2-keymap'."
b3ccb19c KH	370	(defun hangul2-input-method-internal (key)
	371	(let ((char (+ (aref hangul2-keymap (1- (% key 32)))
	372	(cond ((or (= key ?O) (= key ?P)) 2)
	373	((or (= key ?E) (= key ?Q) (= key ?R)
	374	(= key ?T) (= key ?W)) 1)
	375	(t 0)))))
	376	(if (< char 31)
	377	(hangul2-input-method-jaum char)
3436ab42	378	(hangul2-input-method-moum char))))
24b31c88	379
b3ccb19c	380	(defun hangul2-input-method (key)
ebba3e08	381	"2-Bulsik input method."
b3ccb19c KH	382	(if (or buffer-read-only (not (alphabetp key)))
b3ccb19c KH	383	(list key)
3436ab42 KH	384	(quail-setup-overlays nil)
	385	(let ((input-method-function nil)
	386	(echo-keystrokes 0)
	387	(help-char nil))
	388	(setq hangul-queue (make-vector 6 0))
	389	(hangul2-input-method-internal key)
	390	(unwind-protect
	391	(catch 'exit-input-loop
	392	(while t
	393	(let* ((seq (read-key-sequence nil))
	394	(cmd (lookup-key hangul-im-keymap seq))
	395	key)
	396	(cond ((and (stringp seq)
	397	(= 1 (length seq))
	398	(setq key (aref seq 0))
	399	(alphabetp key))
	400	(hangul2-input-method-internal key))
	401	((commandp cmd)
	402	(call-interactively cmd))
	403	(t
	404	(setq unread-command-events (listify-key-sequence seq))
	405	(throw 'exit-input-loop nil))))))
	406	(quail-delete-overlays)))))
24b31c88	407
ebba3e08 KH	408	;; Support function for `hangul3-input-method'. Actually, this
	409	;; function handles the Hangul 3-Bulsik final. KEY is an entered key
	410	;; code used for looking up `hangul3-keymap'."
b3ccb19c KH	411	(defun hangul3-input-method-internal (key)
	412	(let ((char (aref hangul3-keymap (- key 33))))
	413	(cond ((and (> char 92) (< char 123))
	414	(hangul3-input-method-cho (- char 92)))
	415	((and (> char 65) (< char 87))
	416	(hangul3-input-method-jung (- char 35)))
	417	((< char 31)
	418	(hangul3-input-method-jong char))
	419	(t
	420	(setq hangul-queue (make-vector 6 0))
	421	(insert (decode-char 'ucs char))
	422	(move-overlay quail-overlay (point) (point))))))
177c0ea7	423
b3ccb19c	424	(defun hangul3-input-method (key)
ebba3e08	425	"3-Bulsik final input method."
b3ccb19c KH	426	(if (or buffer-read-only (< key 33) (>= key 127))
b3ccb19c KH	427	(list key)
3436ab42 KH	428	(quail-setup-overlays nil)
	429	(let ((input-method-function nil)
	430	(echo-keystrokes 0)
	431	(help-char nil))
	432	(setq hangul-queue (make-vector 6 0))
	433	(hangul3-input-method-internal key)
	434	(unwind-protect
	435	(catch 'exit-input-loop
	436	(while t
	437	(let* ((seq (read-key-sequence nil))
	438	(cmd (lookup-key hangul-im-keymap seq))
	439	key)
	440	(cond ((and (stringp seq)
	441	(= 1 (length seq))
	442	(setq key (aref seq 0))
	443	(and (>= key 33) (< key 127)))
	444	(hangul3-input-method-internal key))
	445	((commandp cmd)
	446	(call-interactively cmd))
	447	(t
	448	(setq unread-command-events (listify-key-sequence seq))
	449	(throw 'exit-input-loop nil))))))
	450	(quail-delete-overlays)))))
177c0ea7	451
ebba3e08 KH	452	;; Support function for `hangul390-input-method'. Actually, this
	453	;; function handles the Hangul 3-Bulsik 390. KEY is an entered key
	454	;; code used for looking up `hangul390-keymap'."
b3ccb19c KH	455	(defun hangul390-input-method-internal (key)
	456	(let ((char (aref hangul390-keymap (- key 33))))
	457	(cond ((or (and (> char 86) (< char 91))
	458	(and (> char 96) (< char 123)))
	459	(hangul3-input-method-cho (- char (if (< char 97) 86 92))))
	460	((and (> char 64) (< char 86))
	461	(hangul3-input-method-jung (- char 34)))
	462	((< char 31)
	463	(hangul3-input-method-jong char))
	464	(t
	465	(setq hangul-queue (make-vector 6 0))
	466	(insert (decode-char 'ucs char))
	467	(move-overlay quail-overlay (point) (point))))))
177c0ea7	468
b3ccb19c	469	(defun hangul390-input-method (key)
ebba3e08	470	"3-Bulsik 390 input method."
b3ccb19c KH	471	(if (or buffer-read-only (< key 33) (>= key 127))
b3ccb19c KH	472	(list key)
3436ab42 KH	473	(quail-setup-overlays nil)
	474	(let ((input-method-function nil)
	475	(echo-keystrokes 0)
	476	(help-char nil))
	477	(setq hangul-queue (make-vector 6 0))
	478	(hangul390-input-method-internal key)
	479	(unwind-protect
	480	(catch 'exit-input-loop
	481	(while t
	482	(let* ((seq (read-key-sequence nil))
	483	(cmd (lookup-key hangul-im-keymap seq))
	484	key)
	485	(cond ((and (stringp seq)
	486	(= 1 (length seq))
	487	(setq key (aref seq 0))
	488	(and (>= key 33) (< key 127)))
	489	(hangul390-input-method-internal key))
	490	((commandp cmd)
	491	(call-interactively cmd))
	492	(t
	493	(setq unread-command-events (listify-key-sequence seq))
	494	(throw 'exit-input-loop nil))))))
	495	(quail-delete-overlays)))))
177c0ea7	496
b3ccb19c KH	497	;; Text shown by describe-input-method. Set to a proper text by
	498	;; hangul-input-method-activate.
	499	(defvar hangul-input-method-help-text nil)
	500	(make-variable-buffer-local 'hangul-input-method-help-text)
177c0ea7	501
b3ccb19c KH	502	(defun hangul-input-method-activate (input-method func help-text &rest args)
	503	"Activate Hangul input method INPUT-METHOD.
	504	FUNC is a function to handle input key.
	505	HELP-TEXT is a text set in `hangul-input-method-help-text'."
	506	(setq inactivate-current-input-method-function 'hangul-input-method-inactivate
3436ab42 KH	507	describe-current-input-method-function 'hangul-input-method-help
3436ab42 KH	508	hangul-input-method-help-text help-text)
b3ccb19c KH	509	(quail-delete-overlays)
	510	(if (eq (selected-window) (minibuffer-window))
	511	(add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))
	512	(set (make-local-variable 'input-method-function) func))
177c0ea7	513
b3ccb19c KH	514	(defun hangul-input-method-inactivate ()
	515	"Inactivate the current Hangul input method."
	516	(interactive)
	517	(unwind-protect
	518	(progn
3436ab42 KH	519	(quail-hide-guidance)
	520	(quail-delete-overlays)
	521	(setq describe-current-input-method-function nil))
b3ccb19c	522	(kill-local-variable 'input-method-function)))
177c0ea7	523
b3ccb19c KH	524	(defun hangul-input-method-help ()
	525	"Describe the current Hangul input method."
	526	(interactive)
	527	(with-output-to-temp-buffer "Help"
	528	(princ hangul-input-method-help-text)))
177c0ea7	529
b3ccb19c	530	(provide 'hangul)
be567141	531
f474904e	532	;; arch-tag: 26bc93fc-64ee-4fb1-b26d-22220d132dbe
be567141	533	;;; hangul.el ends here